ROUTINE PSJOE *7,26,29,33,42,50,56,72,58,85,95,80,110,111,133,140,151,149,181,LOCAL,CRH* ZTPP

From VistApedia
Revision as of 03:12, 18 May 2015 by DavidWhitten (talk | contribs) (= EN^PSJOE REFERS TO)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search

Main Page : ROUTINE PSJOE

^PSJOE

PSJOE * *  207 LINES,  10479 BYTES,  RSUM: 26486001/88572395 Page 1
        UCI: EHR,EHR    Site: Central Regional Hospital MAY 11,2015@11:45

PSJOE^PSJOE

IAs

IA 2191, IA 10118, IA 10116, IA 2789, IA 10035, IA 3620, IA 4133,,,,,,
  1 PSJOE  ;BIR/MLM-INPATIENT ORDER ENTRY ;23 Jun 98 / 1:46 PM
  2 +1     ;;5.0; INPATIENT MEDICATIONS ;**7,26,29,33,42,50,56,72,58,85,95,80,110,111,133,140,151,149,181,LOCAL,CRH**;16 DEC 97;Bui
            ld 190;CRH 2013
  3 +2     ;
  4 +3     ; Reference to ^PS(55 is supported by DBIA #2191.
  5 +4     ; Reference to EN^VALM is supported by DBIA #10118.
  6 +5     ; Reference to FULL^VALM1 and PAUSE^VALM1 is supported by DBIA #10116.
  7 +6     ; Reference to ^PSSLOCK is supported by DBIA #2789
  8 +7     ; Reference to ^DPT is supported by DBIA #10035.
  9 +8     ; Reference to ^ORCFLAG is supported by DBIA #3620.
 10 +9     ; Reference to ^SDAMA203 is supported by DBIA #4133.
 11 +10    ;

EN^PSJOE

EN^PSJOE INTEGRATION AGREEMENTS

EN^PSJOE REFERENCED BY

EN^PSJOE REFERS TO

EN^PSJOE CALLS

EN^PSJOE LOCKS

  • ^PS(53.45, ?? )

EN^PSJOE LOCALS

EN^PSJOE GLOBALS

EN^PSJOE CODE

 12 EN     ; Start Inpatient LM OE
 13 +1     N PSJLK,PSJNEWOE,PSJLMCON,PSJPROT,XQORS,VALMEVL D ENCV^PSGSETU,^PSIVXU
 14 +2     I $D(XQUIT) K XQUIT G DONE
 15 +3     K PSGVBY,PSJPR S (PSJOL,PSJACOK,PSGOP,PSGNEF,PSGOEAV,PSGPXN)="" L +^PS(53.45,PSJSYSP):1 E  D LOCKERR^PSJOE G DONE^PSJOE
 16 +4     F  S (PSJLMCON,PSGPTMP)=0 D ^PSJP,HK Q:PSGP'>0  S PSJPROT=3,DFN=PSGP D ^PSJAC D  I PSJLK D UL^PSSLOCK(PSGP)
 17 +5     .K ^TMP("PSJ",$J)
 18 +6     .S PSJLK=$$L^PSSLOCK(PSGP,1) I 'PSJLK W !,$C(7),$P(PSJLK,U,2) Q
 19 +7     .K PSJLMPRO D EN^VALM("PSJ LM BRIEF PATIENT INFO")
 20 +8     .N NXTPT S NXTPT=0 F  Q:$G(NXTPT)  D
 21 +9     ..K PSGRDTX
 22 +10    ..I $G(PSJLMCON)!$G(PSJNEWOE) D
 23 +11    ...S PSJOL=$S(",S,L,"[(","_$G(PSJOL)_","):PSJOL,1:"S")
 24 +12    ...S PSJLMPRO=1,PSJLMCON=1,PSJNEWOE=0 D EN^VALM("PSJ LM OE")
 25 +13    ..I $G(PSJNEWOE)!($G(VALMBCK)="Q") S PSJNEWOE=0 Q
 26 +14    ..I $G(PSJLMCON)&$G(PSJLMPRO)&'$D(^TMP("PSJ",$J)) D  Q
 27 +15    ...S PSJLMCON=0,PSJLMPRO=0 D EN^VALM("PSJ LM BRIEF PATIENT INFO")
 28 +16    ...I $G(PSJNEWOE) S NXTPT=0 Q
 29 +17    ...S NXTPT=1
 30 +18    ..S NXTPT=1,PSJNEWOE=0
 31 +19    .S PSJOL="S"
 32 +20    .I $G(PSGPXN) I $P(PSJSYSW0,U,29)]""!($G(PSJCOM)) S PSGPXPT=PSGP D  K PSGPXPT S PSGPXN=0
 33 +21    ..N DFN,PSGP,PSJPXDP
 34 +22    ..I $P(PSJSYSW0,U,29)="" S PSJPDXP=1 D
 35 +23    ...;N IO,ION,IOS D HOME^%ZIS S $P(PSJSYSW0,U,29)=+$G(IOS)
 36 +24    ...D HOME^%ZIS S $P(PSJSYSW0,U,29)=+$G(IOS)
 37 +25    ..S (PSGP,DFN)=PSGPXPT D ^PSGPER S:$G(PSJPDXP) $P(PSJSYSW0,U,29)="" K PSJPDXP
 38 +26    .D ENCV^PSGSETU,^PSIVXU
 39 +27    K PSJLMPRO,^TMP("PSJPRO",$J),^TMP("PSJ",$J),^TMP("PSJON",$J)

DONE^PSJOE

 40 DONE   ;
 41 +1     K PSJEXCPT,PSJOCER,^TMP($J,"PSJPRE")
 42 +2     K AC,ACTION,D1,D2,MI,N,ON,P3,PNOW,PSIVAT,PSIVLN,PSIVSTR L -^PS(53.45,PSJSYSP)
 43 +3     K DA,DRG,NE,PSGCF,PSGCANFL,PSGNEDFD,PSGNEF,PSGNEFD,PSGNEPR,PSGNESD,PSJACOK,PSJOE,PSJOECNT,PSJOEPF,PSJORD,PSGOEA,PSGOEAV,
            PSGOL,PSGOS,PSGON,PSGOP,PSGORD,PSGS0XT,PSGS0Y,RCT,ST,WD,XREF,Z,PSJIVORF,PSJIVPCL
 44 +4     K PSGOEORF,PSIVREA,PSJOPC,PSJORL,PSJORPCL,PSJORTOI,RF,WSCHADM,PSJLM,PSJCT
 45 +5     K DIU,DRGI,FLAG,FQC,ND2,PRI,PSGOE,PSGPRI,PSGSDN,PSGOEDMR,PSGOEPR,PSGPTS,PSGTOL,PSGTOO,PSGUOW,PSJIVOF,PSJOCNT,PSJON,PSJOR
            QF,PSJORTOU,PSJORVP
 46 +6     G:$G(PSGPXN) ^PSGPER1 D ENIVKV^PSGSETU
 47 +7     Q

HK^PSJOE

 48 HK     ; Housekeeping (a nice COBOL term)
 49 +1     I PSGOP,PSGOP'=PSGP D
 50 +2     .N PSJACPF,PSJACNWP,PSJPWD,PSJSYSL,PSJSYSW,PSJSYSW0,DFN,VAIN,VAERR S DFN=PSGOP
 51 +3     .D INP^VADPT S PSJPWD=+VAIN(4) I PSJPWD S PSJACPF=10 D WP^PSJAC D:$P(PSJSYSL,"^",2)]"" ENQL^PSGLW
 52 +4     Q:PSGP<0
 53 +5     S (DFN,PSGOP)=PSGP,X=""
 54 +6     Q

SELECT^PSJOE

 55 SELECT ; Select order from list
 56 +1     ;Variable PSJOCDSC is used in Complex order dosing checks
 57 +2     N PSGLMT,PSGODDD,PSJLMQT,PSJLMFIN,PSJUDPRF,PSGRDTX,PSJOCDSC K ^TMP("PSJCOM",$J),^TMP("PSJCOM2",$J)
 58 +3     S PSGONC=1,PSGLMT=^TMP("PSJPRO",$J,0) D ENASR^PSGON
 59 +4     I "^"[X S VALMQUIT=1 Q
 60 +5     S PSJLM=1,PSJSEL=0 F  S PSJSEL=$O(PSGODDD(PSJSEL)) Q:'PSJSEL!($G(Y)<0)  F PSJSEL1=1:1:$L(PSGODDD(PSJSEL),",")-1 D
 61 +6     .K PSJOCDSC
 62 +7     .S PSJORD=$G(^TMP("PSJON",$J,+$P(PSGODDD(PSJSEL),",",PSJSEL1))) D:PSJORD=+PSJORD SELECT^PSJOEA Q:PSJORD=""!($G(Y)<0)  Q:
            PSJORD=+PSJORD  D
 63 +8     ..Q:('$$LS^PSSLOCK(PSGP,PSJORD))
 64 +9     ..Q:PSJORD=+PSJORD
 65 +10    ..S PSGORD=""
 66 +11    ..D DISACTIO(PSGP,PSJORD,"") S:PSJORD["V" PSJORD=ON
 67 +12    ..D UNL^PSSLOCK(PSGP,PSJORD) Q:$G(Y)<0
 68 +13    S VALMBCK="Q"
 69 +14    K PSJLM,PSJOCDSC
 70 +15    Q

DISACTIO^PSJOE

 71 DISACTIO(DFN,PSJORD,PSJPNV) --
                  ; Display UD order and allow actions.
 72 +1     ; PSJORD - Order #_location Code (P:53.1,V:55.01,U:55.06)
 73 +2     ; PSJPNV - Invoked from Pending/NV option; (gets different hidden menu)
 74 +3     N PSGP,PSJIVFLG,PSGSDX,PSGFDX,PSJXX1,ON55
 75 +4     D OLDCOM^PSJOE0(DFN,PSJORD)
 76 +5     S PSGP=DFN D ENIV^PSJAC I PSJORD["V" D EN^PSJLIORD(DFN,PSJORD) Q
 77 +6     D GETUD^PSJLMGUD(DFN,PSJORD)
 78 +7     S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU
 79 +8     S:$G(PSJTUD) PSGPD=$G(PSJCOI),PSGPDN=$$OINAME^PSJLMUTL(+PSGPD)
 80 +9     K PSGOENG I '$D(PSGPRF) D  Q:$G(PSGOENG)
 81 +10    . I PSJORD["U" L +^PS(55,PSGP,5,+PSJORD):1 E  S PSGOENG=1
 82 +11    . I PSJORD["P" L +^PS(53.1,+PSJORD):1 E  S PSGOENG=1
 83 +12    . ;LOCAL MOD DJW 10/2013 - Make message unique
 84 +13    . ; include NON VERIFIED ORDER number in message
 85 +14    . ;I $G(PSGOENG) W !,"This order is being edited by another terminal.",! S PSGOENG=1 K DIR S DIR(0)="E" D ^DIR K DIR Q
 86 +15    . I $G(PSGOENG) D  Q
 87 +16    .. W !,"This order "_$S(PSJORD["U":"UD#",1:"NVO#")_+PSJORD_" is being edited by a different terminal.",!
 88 +17    .. S PSGOENG=1 K DIR S DIR(0)="E" D ^DIR K DIR Q
 89 +18    . ;END LOCAL MOD DJW 10/2013
 90 +19    S PSGACT=$$ENACTION^PSGOE1(PSGP,PSJORD)
 91 +20    I PSJORD["P" S PSJXX1=$G(^PS(53.1,+PSJORD,0)) I PSGP'=$P(PSJXX1,U,15)!(DFN'=$P(PSJXX1,U,15)) L -^PS(53.1,+PSJORD) Q
 92 +21    I PSJORD["P" D  S PSJXX1=$P($G(^PS(53.1,+PSJORD,0)),U,9) I $S($G(PSJIVFLG):1,$G(Y)<0:1,"PADE"[PSJXX1:1,1:0) L -^PS(53.1,
            +PSJORD) Q
 93 +22    .I $P(PSJXX1,U,9)="N",($P(PSJXX1,U,4)'="U") D  Q
 94 +23    .. S P("PON")=PSJORD,PSIVFLG=1
 95 +24    .. N ON S ON=PSJORD D VF^PSIVORC2
 96 +25    .I $P(PSJXX1,U,9)="P" D  Q
 97 +26    ..S:$G(PSJTUD) $P(PSJXX1,U,4)="U"
 98 +27    ..I $P(PSJXX1,U,4)="U" D  Q:$G(PSJIVFLG)
 99 +28    ... N VAIP S CLINIC=$G(^PS(53.1,+PSJORD,"DSS")),APPT=$P(CLINIC,"^",2),CLINIC=$P(CLINIC,"^") I $$PATCH^XPDUTL("SD*5.3*285
            "),$$SDIMO^SDAMA203(CLINIC,DFN)>-1 Q
100 +29    ... Q:'PSJPDD  W !!,"Cannot process an Out-patient Unit Dose order for ",$P($G(^DPT(+PSGP,0)),U) D PAUSE^VALM1 S PSJIVFL
            G=1
101 +30    ..NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
102 +31    ..D REQDT^PSJLIVMD(PSJORD)
103 +32    ..I $P(PSJXX1,U,4)="U",($G(PSGSCH)="") W !!,"Invalid schedule, can't finish this order" D PAUSE^VALM1 Q
104 +33    ..I $P(PSJXX1,U,4)="U" N PSJLM S PSJLM=1,PSGORD=PSJORD D START^PSGOEF,ENSFE^PSGOEE0(PSGP,PSGORD),@$S($G(PSJTUD):"FINISH^
            PSGOEF",1:"EN^VALM(""PSJ LM PENDING EDIT"")") Q
105 +34    ..I $P(PSJXX1,U,4)'="U",PSGP=$P(PSJXX1,U,15),DFN=$P(PSJXX1,U,15) S PSJLYN=PSJORD D EN^PSJLIFN S PSJIVFLG=1 K PSJLYN,PSJM
            AI
106 +35    I $G(PSIVFLG) K PSIVFLG Q
107 +36    S PSGACT=$$ENACTION^PSGOE1(PSGP,PSJORD),PSGOEEF=0 D GETUD^PSJLMGUD(PSGP,PSJORD),ENSFE^PSGOEE0(PSGP,PSJORD),EN^VALM("PSJ 
            LM UD ACTION")
108 +37    I PSJORD["P" L -^PS(53.1,+PSJORD)
109 +38    I PSJORD["U" L -^PS(55,PSGP,5,+PSJORD)
110 +39    ;Send SN to CPRS if auto-verify OFF and Order Set Entry and no 21st piece
111 +40    S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU
112 +41    I $D(PSGOES),'PSGOEAV,$D(PSGORD),PSGORD["P",$P($G(^PS(53.1,+PSGORD,0)),"^",21)']"" D ORSET^PSGOETO1
113 +42    D UNL^PSSLOCK(PSGP,PSJORD)
114 +43    Q

EDIT^PSJOE

115 EDIT(PSGP,PSGORD,PROMPT) --
            ;
116 +1     I "DE"[$$GTSTATUS(PSGP,PSGORD) W !,"This order may not be edited." D PAUSE^VALM1 Q
117 +2     I PSGACT'["E" W !,"This order may not be edited." D PAUSE^VALM1 Q
118 +3     S PSGNEDFD="" D HOLDHDR,@$S('PROMPT:"ENEFA2^PSGON",1:"ENEFA^PSGON") I 'Y D ABORT^PSGOEE Q
119 +4     I PSGORD["P" D ENF^PSGOEE Q
120 +5     D ACT^PSGOEE
121 +6     Q

RENEW^PSJOE

122 RENEW(PSGP,PSGORD) --
            ;
123 +1     D HOLDHDR
124 +2     I 'PSJSYSU,$P($G(^PS(55,PSGP,5,+PSGORD,4)),U,15),$P($G(^(4)),U,16) W !!,"This order is already marked for renewal!" D PA
            USE^VALM1 S VALMBCK="R" Q
125 +3     I 'PSGRRF D ^PSGOER Q
126 +4     D ^PSGOERI
127 +5     Q

GISTATUS^PSJOE

128 GTSTATUS(DFN,ON) --
              ;
129 +1     I ON["P" Q $P($G(^PS(53.1,+ON,0)),U,9)
130 +2     I ON["U" Q $P($G(^PS(55,DFN,5,+ON,0)),U,9)
131 +3     Q $P($G(^PS(55,DFN,"IV",+ON,0)),U,17)

DC^PSJOE

132 DC(DFN,PSJORD) --
            ; DC IV, UD, or pending orders.
133 +1     D HOLDHDR
134 +2     S X=$$GTSTATUS(DFN,PSJORD) I X="D"!(X="DE")!(X="R") W !,$S(X="R":"This order has a pending renewal and cannot be DISCONT
            INUED.",1:"This order has already been DISCONTINUED.") D PAUSE^VALM1 Q
135 +3     D ENO^PSGOEC(DFN,PSJORD) ;,GETUD^PSJLMGUD(DFN,PSJORD),INIT^PSJLMUDE(DFN,PSJORD) S VALMBCK="Q"
136 +4     S VALMBCK="Q"
137 +5     Q

HOLD^PSJOE

138 HOLD(DFN,PSJORD) --
            ; Change order's status from ACTIVE<->HOLD
139 +1     D HOLDHDR
140 +2     I PSJORD["V" D H^PSIVOPT(DFN,PSJORD,P(17),P(3))
141 +3     I PSJORD'["V" D H^PSGOE1(DFN,PSJORD)
142 +4     D GETUD^PSJLMGUD(DFN,PSJORD),INIT^PSJLMUDE(DFN,PSJORD) S PSGACT=$$ENACTION^PSGOE1(DFN,PSJORD),VALMBCK="R"
143 +5     Q

COPY^PSJOE

144 COPY(PSGP,PSGORD) --
             ; Copy an order (does not discontinue original order)
145 +1     I $D(PSGCOPY) W !!,"You cannot copy the order at this time" D PAUSE^VALM1 Q
146 +2     I PSGORD["P" W !!,"You cannot copy this "_$S($G(PSGSTAT)]"":PSGSTAT,1:"PENDING IV")_" order." D PAUSE^VALM1 Q
147 +3     I PSGORD["V" D  Q
148 +4     .I $G(PSIVCOPY) W !!,"You cannot copy the order at this time" D PAUSE^VALM1 Q
149 +5     .D COPY^PSIVOD(PSGP,PSGORD) Q
150 +6     Q:'$$HIDDEN^PSJLMUTL("COPY")
151 +7     D ^PSJHVARS
152 +8     I $P($G(^PS(55,PSGP,5,+PSGORD,.2)),U,4)="D",'$P($G(^(4)),"^",3) W !!,"Nurse verified orders with a priority of DONE may 
            not be Copied." D PAUSE^VALM1 Q
153 +9     S PSGOEAV=$P(PSJSYSP0,U,9)&PSJSYSU
154 +10    S PSGCOPY=1
155 +11    D FULL^VALM1,^PSGOD
156 +12    S VALMBCK="R"
157 +13    K PSGCOPY
158 +14    S PSGACT=$$ENACTION^PSGOE1(PSGP,PSGORD) ; resets PSGACT after copy
159 +15    I $G(PSGPXN) N PSGTMPXN S PSGTMPXN=PSGPXN
160 +16    D RESTORE^PSJHVARS I $G(PSGTMPXN) S PSGPXN=PSGTMPXN
161 +17    Q

UPDATE^PSJOE

162 UPDATE ; Refresh array, actions, & display.
163 +1     D GETUD^PSJLMGUD(DFN,ON),INIT^PSJLMUDE(DFN,ON) S VALMBCK="R"
164 +2     Q

FINISH^PSJOE

165 FINISH ;
166 +1     D FINISH^PSGOEF,PAUSE^VALM1
167 +2     Q

LOG^PSJOE

168 LOG(DFN,PSGORD) --
                   ;
169 +1     D FULL^VALM1,ENLM^PSGOEL(DFN,PSGORD),PAUSE^VALM1 S VALMBCK="R"
170 +2     Q

NEWSEL^PSJOE

171 NEWSEL ;
172 +1     N PSGLMT,PSGODDD,PSJLMQT,PSJLMFIN,PSJUDPRF,PSGRDTX,PSJOCDSC K ^TMP("PSJCOM",$J),^TMP("PSJCOM2",$J)
173 +2     S X=$P(XQORNOD(0),"=",2)
174 +3     S PSGONC=1,PSGLMT=^TMP("PSJPRO",$J,0)
175 +4     D ENCHK^PSGON I '$O(PSGODDD(0)) S VALMQUIT=1 Q
176 +5     S PSJLM=1,PSJSEL=0 F  S PSJSEL=$O(PSGODDD(PSJSEL)) Q:'PSJSEL  F PSJSEL1=1:1:$L(PSGODDD(PSJSEL),",")-1 D
177 +6     .K PSJOCDSC
178 +7     .S PSJORD=$G(^TMP("PSJON",$J,+$P(PSGODDD(PSJSEL),",",PSJSEL1))) D:PSJORD=+PSJORD SELECT^PSJOEA
179 +8     .Q:PSJORD=+PSJORD 
180 +9     .Q:PSJORD=""!($G(Y)<0)  Q:('$$LS^PSSLOCK(PSGP,PSJORD))  D
181 +10    ..S PSGORD=""
182 +11    ..S ON=PSJORD
183 +12    ..D DISACTIO(PSGP,PSJORD,$G(PSJPNV)) S:PSJORD["V" PSJORD=ON
184 +13    ..D UNL^PSSLOCK(PSGP,PSJORD)
185 +14    ..I $G(PSJNOL) K PSJNOL I $D(ON),ON'=PSJORD D UNL^PSSLOCK(PSGP,ON)
186 +15    ..Q:$G(Y)<0
187 +16    S VALMBCK="Q"
188 +17    K PSJLM,PSJOCDSC
189 +18    Q

HOLDHDR^PSJOE

190 HOLDHDR ; Freeze header text while processing order actions
191 +1     I $D(VALM("TM")) S IOTM=VALM("TM"),IOBM=IOSL W IOSC W @IOSTBM W IORC
192 +2     Q

LOCKERR^PSJOE

193 LOCKERR ;
194 +1     W !!,$C(7),"You are entering or editing an Inpatient Medication order in another session.",!,"Only one order entry/edit 
            session is allowed for a user at a time.",!! N DIR S DIR(0)="E" D ^DIR
195 +2     Q

FLAG^PSJOE

196 FLAG(DFN,PSJORD) --
            ;Flag order through CPRS entry point.
197 +1     N ORIFN,NODE0
198 +2     S NODE0=$S(PSJORD["V":$G(^PS(55,DFN,"IV",+PSJORD,0)),PSJORD["U":$G(^PS(55,DFN,5,+PSJORD,0)),1:^PS(53.1,+PSJORD,0))
199 +3     S ORIFN=$P(NODE0,"^",21)
200 +4     D EN1^ORCFLAG(ORIFN)
201 +5     D PAUSE^VALM1
202 +6     Q

COMPLEX^PSJOE

203 COMPLEX(DFN,ON) --
            ;
204 +1     N NDP2,COM
205 +2     S NDP2=$S(ON["P":$G(^PS(53.1,+ON,.2)),ON["U":$G(^PS(55,DFN,5,+ON,.2)),ON["V":$G(^PS(55,DFN,"IV",+ON,.2)),1:"")
206 +3     S COM=$P(NDP2,"^",8) I COM Q 1
207 +4     Q 0

LOCAL VARS

Local Variables      Line Occurrences   ( >> not killed explicitly)
                                       ( * Changed  ! Killed  ~ Newed)
  AC           DONE+2!
  ACTION       DONE+2!
>> APPT         DISACTIO+28*
>> CLINIC       DISACTIO+28*
  COM          COMPLEX+1~,COMPLEX+3*
  D1           DONE+2!
  D2           DONE+2!
  DA           DONE+3!
  DFN          EN+4*,EN+21~,EN+25*,HK+2~*,HK+5*,DISACTIO~,DISACTIO+4,DISACTIO+5,DISACTIO+6,DISACTIO+20,DISACTIO+28,DISACTIO+34
               GTSTATUS~,GTSTATUS+2,GTSTATUS+3,DC~,DC+2,DC+3,HOLD~,HOLD+2,HOLD+3,HOLD+4,UPDATE+1,LOG~,LOG+1,FLAG~,FLAG+2,COMPLEX~
               COMPLEX+2
  DIR          DISACTIO+17!,LOCKERR+1~
  DIR(0        DISACTIO+17*,LOCKERR+1*
  DIU          DONE+5!
  DRG          DONE+3!
  DRGI         DONE+5!
  FLAG         DONE+5!
  FQC          DONE+5!
>> IOBM         HOLDHDR+1*
>> IORC         HOLDHDR+1
>> IOS          EN+24
>> IOSC         HOLDHDR+1
  IOSL         HOLDHDR+1
>> IOSTBM       HOLDHDR+1
>> IOTM         HOLDHDR+1*
  MI           DONE+2!
  N            DONE+2!
  ND2          DONE+5!
  NDP2         COMPLEX+1~,COMPLEX+2*,COMPLEX+3
  NE           DONE+3!
  NODE0        FLAG+1~,FLAG+2*,FLAG+3
  NXTPT        EN+8~*,EN+16*,EN+17*,EN+18*
  ON           DONE+2!,SELECT+11,DISACTIO+24~*,GTSTATUS~,GTSTATUS+1,GTSTATUS+2,GTSTATUS+3,UPDATE+1,NEWSEL+11*,NEWSEL+12,NEWSEL+14
               COMPLEX~,COMPLEX+2
  ON55         DISACTIO+3~
  ORIFN        FLAG+1~,FLAG+3*,FLAG+4
>> P("PON"      DISACTIO+23*
>> P(17         HOLD+2
>> P(3          HOLD+2
  P3           DONE+2!
  PNOW         DONE+2!
  PRI          DONE+5!
  PROMPT       EDIT~,EDIT+3
>> PSGACT       DISACTIO+19*,DISACTIO+36*,EDIT+2,HOLD+4*,COPY+14*
  PSGCANFL     DONE+3!
  PSGCF        DONE+3!
  PSGCOPY      COPY+1,COPY+10*,COPY+13!
  PSGFDX       DISACTIO+3~
  PSGLMT       SELECT+2~,SELECT+3*,NEWSEL+1~,NEWSEL+3*
  PSGNEDFD     DONE+3!,EDIT+3*
  PSGNEF       EN+3*,DONE+3!
  PSGNEFD      DONE+3!
  PSGNEPR      DONE+3!
  PSGNESD      DONE+3!
  PSGODDD      SELECT+2~,NEWSEL+1~
  PSGODDD(     SELECT+5,SELECT+7,NEWSEL+5,NEWSEL+7