PSJOCDC ;BIR/MV - NEW ORDER CHECKS MISC. ;6 Jun 07 / 3:37 PM
;;5.0;INPATIENT MEDICATIONS ;**181,260**;16 DEC 97;Build 94
;
; Reference to ^PS(55 is supported by DBIA 2191.
;
DC(PSGP,PSJORD,PSJCLINF) ;DC orders during Duplicate Therapy order checks
;PSGP - Patient DFN
;PSJORD - Order #_u/v/p
;Save local arrays and variables to be restored after DC order(s)
Q:'$D(PSJORD)
S PSJDCDTF=1
D ^PSJOCVAR
NEW ON S ON=PSJORD
I $$DSPORD(PSJORD,.PSJCLINF) D DCORD
D RESTORE^PSJOCVAR
K PSJDCDTF
Q
DCORD ;DC order according to order type
;PSJOCFLG is used in DC^PSJLIACT so the newly DC order during DT will not redisplay.
NEW PSJOCFLG S PSJOCFLG=1
I PSJORD["U" D DCUD Q
; DC pending, active IV and complex orders
D DC^PSJLIACT
Q
DSPORD(PSJORD,PSJCLINF) ;Display the order about to DC and check if the user wish to DC to order
;Returns 1 if continuing with DC the duplicate order.
;Returns 0 if not to DC.
;
NEW %
D DSPORD^PSJOC(PSJORD,,.PSJCLINF)
;DC^PSJOE does the DC prompt
I PSJORD["U" Q 1
ASKDC W !!,"Enter DC to discontinue the above order or press <RETURN> to continue:" S %=2 D TST4DC^PSGOEC W:%=2 !,"No action taken!"
W !
I %="" D ENDC^PSGOEM W ! G ASKDC
I %=1 Q 1
Q 0
DCUD ;DC a U/D order
;Setup necessary variables needed by DC^PSJOE
NEW PSGOEEWF,PSGSTAT,DIR,PSJDCFLG
S PSJDCFLG=1
S PSGSTAT=$P($G(^PS(55,PSGP,5,+PSJORD,0)),U,9)
S PSGOEEWF="^PS(55,"_PSGP_",5,"_+PSJORD_","
D SYSL^PSGSETU
D DC^PSJOE(PSGP,PSJORD)
K PSJDCFLG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJOCDC 1511 printed Nov 22, 2024@17:18:04 Page 2
PSJOCDC ;BIR/MV - NEW ORDER CHECKS MISC. ;6 Jun 07 / 3:37 PM
+1 ;;5.0;INPATIENT MEDICATIONS ;**181,260**;16 DEC 97;Build 94
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ;
DC(PSGP,PSJORD,PSJCLINF) ;DC orders during Duplicate Therapy order checks
+1 ;PSGP - Patient DFN
+2 ;PSJORD - Order #_u/v/p
+3 ;Save local arrays and variables to be restored after DC order(s)
+4 if '$DATA(PSJORD)
QUIT
+5 SET PSJDCDTF=1
+6 DO ^PSJOCVAR
+7 NEW ON
SET ON=PSJORD
+8 IF $$DSPORD(PSJORD,.PSJCLINF)
DO DCORD
+9 DO RESTORE^PSJOCVAR
+10 KILL PSJDCDTF
+11 QUIT
DCORD ;DC order according to order type
+1 ;PSJOCFLG is used in DC^PSJLIACT so the newly DC order during DT will not redisplay.
+2 NEW PSJOCFLG
SET PSJOCFLG=1
+3 IF PSJORD["U"
DO DCUD
QUIT
+4 ; DC pending, active IV and complex orders
+5 DO DC^PSJLIACT
+6 QUIT
DSPORD(PSJORD,PSJCLINF) ;Display the order about to DC and check if the user wish to DC to order
+1 ;Returns 1 if continuing with DC the duplicate order.
+2 ;Returns 0 if not to DC.
+3 ;
+4 NEW %
+5 DO DSPORD^PSJOC(PSJORD,,.PSJCLINF)
+6 ;DC^PSJOE does the DC prompt
+7 IF PSJORD["U"
QUIT 1
ASKDC WRITE !!,"Enter DC to discontinue the above order or press <RETURN> to continue:"
SET %=2
DO TST4DC^PSGOEC
if %=2
WRITE !,"No action taken!"
+1 WRITE !
+2 IF %=""
DO ENDC^PSGOEM
WRITE !
GOTO ASKDC
+3 IF %=1
QUIT 1
+4 QUIT 0
DCUD ;DC a U/D order
+1 ;Setup necessary variables needed by DC^PSJOE
+2 NEW PSGOEEWF,PSGSTAT,DIR,PSJDCFLG
+3 SET PSJDCFLG=1
+4 SET PSGSTAT=$PIECE($GET(^PS(55,PSGP,5,+PSJORD,0)),U,9)
+5 SET PSGOEEWF="^PS(55,"_PSGP_",5,"_+PSJORD_","
+6 DO SYSL^PSGSETU
+7 DO DC^PSJOE(PSGP,PSJORD)
+8 KILL PSJDCFLG
+9 QUIT
