- PSIVACT ;BIR/PR,MLM - UPDATE ORDER STATUS AFTER PATIENT SELECTION ;Jul 02, 2018@09:29
- ;;5.0;INPATIENT MEDICATIONS;**15,38,58,110,181,275,304,373**;16 DEC 97;Build 3
- ;
- ; Reference to ^PS(55 is supported by DBIA 2191
- ;
- ENNA ; Inpatient entry point.
- D:$D(XRTL) T0^%ZOSV
- D NOW^%DTC S PSFDT=%,PS=0 D L D:'$G(PSIVRD) PEND
- I $D(XRT0) S XRTN="PSIVACT" D T1^%ZOSV
- Q
- ;
- ENNB ; Ask profile type, gather orders.
- D NOW^%DTC S PSFDT=%,PS=0 K ^TMP("PSIV",$J),^TMP("PSJPRO",$J)
- S PSIVNV=$S(+PSJSYSU=1:"ANIV",+PSJSYSU=3:"APIV",1:"")
- D @P("PT") D:'$G(PSIVRD) PEND
- I P("PT")="L",$D(XRT0) S XRTN="PSIVACT" D T1^%ZOSV
- Q
- ;
- L ; Long profile
- S:'$D(PSJSYSU) PSJSYSU=""
- F ON=0:0 K Y S ON=$O(^PS(55,DFN,"IV",+ON)) Q:'ON D SETP
- Q
- ;
- S ; Short profile.
- S PSJDCEXP=$$RECDCEXP^PSJP()
- I '+$P(PSJDCEXP,U,2) S $P(PSJDCEXP,U,2)=PSFDT
- F PSIVDT=$P($G(PSJDCEXP),U,2):0 S PSIVDT=$O(^PS(55,DFN,"IV","AIS",PSIVDT)) Q:'PSIVDT!(PSIVDT'=+PSIVDT) F ON=0:0 S ON=$O(^PS(55,DFN,"IV","AIS",PSIVDT,+ON)) Q:'ON S ON=ON_"V",P(17)=$P($G(^PS(55,DFN,"IV",+ON,0)),U,17) D ACTO
- I +PSJSYSU=3 S PSIVNV="APIV" D NVACT K PSIVNV
- Q
- ;
- NVACT ; Non-verified but have active status
- NEW ON S PSGP=DFN ;added PSGP #373
- F ON=0:0 S ON=$O(^PS(55,PSIVNV,DFN,ON)) Q:'ON D
- . N CLIN,CLINSORT,SORT,PSIVSTAT,CLINSORT S PSIVSTAT="A"
- . S CLIN=$$CLINIC^PSJO1(PSGP,ON) I $L(CLIN)>1 S CLINSORT=$$CLINSORT^PSJO1("A") S PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^A"
- . I $P($G(^PS(55,DFN,"IV",ON,0)),U,17)="E",($P($G(^(.2)),U,4)="D") S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)=""
- Q
- ;
- PEND ; Get pending and non-verified orders from 53.1
- N PSJCOM,PSJCOM1 S (PSJCOM,PSJCOM1)=0,PSGP=DFN ;added PSGP #373
- F ON=0:0 S ON=$O(^PS(53.1,"AS","P",DFN,ON)) Q:'ON D S PSJCOM1=PSJCOM
- . NEW X S X=$P($G(^PS(53.1,ON,.2)),U,4),X=$S(X="S":1,X="A":2,X="R":3,X="P":4,1:5)
- . S PSJCOM=$P($G(^PS(53.1,ON,.2)),U,8) I PSJCOM Q:'$$COMCHK^PSJO1(PSJCOM,2) Q:PSJCOM=PSJCOM1
- . N CLIN,CLINSORT,SORT,PSIVSTAT,CLINSORT S PSIVSTAT=$S('PSJCOM:"P",1:"PD")
- . S CLIN=$$CLINIC^PSJO1(PSGP,ON_"P") I $L(CLIN)>1 S CLINSORT=$$CLINSORT^PSJO1("P") S PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT
- . I $G(^PS(53.1,ON,0)),$P(^PS(53.1,ON,0),U,4)'="U" S ^TMP("PSIV",$J,PSIVSTAT,X_9999999999-ON)=""
- F ON=0:0 S ON=$O(^PS(53.1,"AS","N",DFN,ON)) Q:'ON D S PSJCOM1=PSJCOM
- . NEW X S X=$P($G(^PS(53.1,ON,.2)),U,4),X=$S(X="S":1,X="A":2,X="R":3,X="P":4,1:5)
- . S PSJCOM=$P($G(^PS(53.1,ON,.2)),U,8) I PSJCOM Q:'$$COMCHK^PSJO1(PSJCOM,2) Q:PSJCOM=PSJCOM1
- . N CLIN,PSIVSTAT,CLINSORT,SORT S PSIVSTAT=$S('PSJCOM:"N",1:"ND")
- . S CLIN=$$CLINIC^PSJO1(PSGP,ON_"P") I (CLIN]"") S CLINSORT=$$CLINSORT^PSJO1("P") S PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_$S('PSJCOM:"N",1:"ND")
- . I $G(^PS(53.1,ON,0)),$P(^PS(53.1,ON,0),U,4)'="U" S ^TMP("PSIV",$J,PSIVSTAT,X_9999999999-ON)=""
- .; S:$P(^PS(53.1,ON,0),U,4)'="U" ^TMP("PSIV",$J,"P",X_9999999999-ON)=""
- ;
- QUIT ; Kill and exit.
- K PSIVCWD,PSIVFLAG,PSIVWD,PSDFN,PSON1,PSFDT,YHOLD,JJ,XHOLD
- Q
- ;
- SETP ; Get partial P array,
- S ON=ON_"V",Y=$G(^PS(55,DFN,"IV",+ON,0)) F X=2,3,17,21 S P(X)=$P(Y,U,X)
- S P(2)=+P(2),P(3)=+P(3) S Y(P(2))="",Y(P(3))=""
- I P(2),P(3),P(17)'="P" D CHK
- Q
- ;
- CHK ; Check if order is active or expired and save accordingly.
- N CLIN,PSIVSTAT,CLINSORT,SORT S PSIVSTAT="A",PSGP=DFN ;373 added PSGP
- S CLIN=$$CLINIC^PSJO1(PSGP,ON) I CLIN]"" S CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT) S PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^A"
- S PS=PS+1 I P(17)="H" S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)="" Q
- I $O(Y(PSFDT))=P(3) D ACTO Q
- I $O(Y(PSFDT))="" D NACTO Q
- S:"ARO"[P(17) ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)="" S:"ED"[P(17) ^TMP("PSIV",$J,"X",9999999999-ON)="" S:"E"[P(17) PSIVREA="A",$P(^PS(55,DFN,"IV",+ON,0),U,17)="A",PS("A",9999999999-ON)=""
- Q
- ;
- ACTO ; Active orders
- ;I "AE"[P(17) S ^TMP("PSIV",$J,"A",9999999999-ON)="" S:P(17)="E" $P(^PS(55,DFN,"IV",+ON,0),U,17)="A" Q ;;mv-not sure why setting status back to "A"???
- N CLINSORT,SORT,CLIN,PSIVSTAT S PSIVSTAT="A",PSGP=DFN ;added PSGP #373
- S CLIN=$$CLINIC^PSJO1(PSGP,ON) I (CLIN]"") S CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT) S PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^A"
- I ($P(PSIVSTAT,"^")="Cz") S:("DE"[P(17)) PSIVSTAT="RD" S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)="" Q
- I "A"[P(17) S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)="" Q
- I "HOR"[P(17) S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)="" Q
- I "DE"[P(17) S ^TMP("PSIV",$J,"RD",9999999999-ON)=""
- Q
- ;
- NACTO ; Inactive orders
- ;I "AER"[P(17) S ^TMP("PSIV",$J,"X",9999999999-ON)="" I "AR"[P(17) S $P(^PS(55,DFN,"IV",+ON,0),U,17)="E" D EXPIR^PSIVOE Q
- N CLIN,PSIVSTAT,SORT,CLINSORT S PSIVSTAT="",PSGP=DFN ;added PSGP #373
- S CLIN=$$CLINIC^PSJO1(PSGP,ON)
- I "AER"[P(17) D
- . Q:$P(^PS(55,DFN,"IV",+ON,0),U,3)="" S PSIVSTAT="A"
- . I +PSJSYSU=3,($P($G(^PS(55,DFN,"IV",+ON,.2)),U,4)="D"),'+$P($G(^(4)),U,4) D Q
- .. I (CLIN]"") S CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT) S PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT
- .. S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)=""
- . S PSIVSTAT="X" S:(CLIN]"") CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT) S:($G(CLINSORT)]"") PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT D
- .. S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)=""
- I "AR"[P(17) S $P(^PS(55,DFN,"IV",+ON,0),U,17)="E" D EXPIR^PSIVOE
- I "OD"[P(17) S PSIVSTAT="X" S:(CLIN]"") CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT) S:($G(CLINSORT)]"") PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT D
- .S ^TMP("PSIV",$J,PSIVSTAT,9999999999-ON)=""
- Q
- ;
- DCOR ; Auto-cancel IV orders
- ;NEED TO NEW VARIABLES LATER.
- NEW DA,DIR,DG,ON,ON55,P,PSIVAC,PSIVACT,PSIVLN,PSIVREA,PSIVRES,PSGALO,PSGP,PSJDCDT,PSJIVDCF,PSJIVON,PSJIVORF,PSJORF,VA,VADM,VAERR
- S PSGP=DFN,PSIVRES="Auto DC due to Surgery Package"
- D NOW^%DTC S PSJDCDT=+%
- D ENIV^PSJADT0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVACT 5735 printed Feb 18, 2025@23:30:10 Page 2
- PSIVACT ;BIR/PR,MLM - UPDATE ORDER STATUS AFTER PATIENT SELECTION ;Jul 02, 2018@09:29
- +1 ;;5.0;INPATIENT MEDICATIONS;**15,38,58,110,181,275,304,373**;16 DEC 97;Build 3
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA 2191
- +4 ;
- ENNA ; Inpatient entry point.
- +1 if $DATA(XRTL)
- DO T0^%ZOSV
- +2 DO NOW^%DTC
- SET PSFDT=%
- SET PS=0
- DO L
- if '$GET(PSIVRD)
- DO PEND
- +3 IF $DATA(XRT0)
- SET XRTN="PSIVACT"
- DO T1^%ZOSV
- +4 QUIT
- +5 ;
- ENNB ; Ask profile type, gather orders.
- +1 DO NOW^%DTC
- SET PSFDT=%
- SET PS=0
- KILL ^TMP("PSIV",$JOB),^TMP("PSJPRO",$JOB)
- +2 SET PSIVNV=$SELECT(+PSJSYSU=1:"ANIV",+PSJSYSU=3:"APIV",1:"")
- +3 DO @P("PT")
- if '$GET(PSIVRD)
- DO PEND
- +4 IF P("PT")="L"
- IF $DATA(XRT0)
- SET XRTN="PSIVACT"
- DO T1^%ZOSV
- +5 QUIT
- +6 ;
- L ; Long profile
- +1 if '$DATA(PSJSYSU)
- SET PSJSYSU=""
- +2 FOR ON=0:0
- KILL Y
- SET ON=$ORDER(^PS(55,DFN,"IV",+ON))
- if 'ON
- QUIT
- DO SETP
- +3 QUIT
- +4 ;
- S ; Short profile.
- +1 SET PSJDCEXP=$$RECDCEXP^PSJP()
- +2 IF '+$PIECE(PSJDCEXP,U,2)
- SET $PIECE(PSJDCEXP,U,2)=PSFDT
- +3 FOR PSIVDT=$PIECE($GET(PSJDCEXP),U,2):0
- SET PSIVDT=$ORDER(^PS(55,DFN,"IV","AIS",PSIVDT))
- if 'PSIVDT!(PSIVDT'=+PSIVDT)
- QUIT
- FOR ON=0:0
- SET ON=$ORDER(^PS(55,DFN,"IV","AIS",PSIVDT,+ON))
- if 'ON
- QUIT
- SET ON=ON_"V"
- SET P(17)=$PIECE($GET(^PS(55,DFN,"IV",+ON,0)),U,17)
- DO ACTO
- +4 IF +PSJSYSU=3
- SET PSIVNV="APIV"
- DO NVACT
- KILL PSIVNV
- +5 QUIT
- +6 ;
- NVACT ; Non-verified but have active status
- +1 ;added PSGP #373
- NEW ON
- SET PSGP=DFN
- +2 FOR ON=0:0
- SET ON=$ORDER(^PS(55,PSIVNV,DFN,ON))
- if 'ON
- QUIT
- Begin DoDot:1
- +3 NEW CLIN,CLINSORT,SORT,PSIVSTAT,CLINSORT
- SET PSIVSTAT="A"
- +4 SET CLIN=$$CLINIC^PSJO1(PSGP,ON)
- IF $LENGTH(CLIN)>1
- SET CLINSORT=$$CLINSORT^PSJO1("A")
- SET PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^A"
- +5 IF $PIECE($GET(^PS(55,DFN,"IV",ON,0)),U,17)="E"
- IF ($PIECE($GET(^(.2)),U,4)="D")
- SET ^TMP("PSIV",$JOB,PSIVSTAT,9999999999-ON)=""
- End DoDot:1
- +6 QUIT
- +7 ;
- PEND ; Get pending and non-verified orders from 53.1
- +1 ;added PSGP #373
- NEW PSJCOM,PSJCOM1
- SET (PSJCOM,PSJCOM1)=0
- SET PSGP=DFN
- +2 FOR ON=0:0
- SET ON=$ORDER(^PS(53.1,"AS","P",DFN,ON))
- if 'ON
- QUIT
- Begin DoDot:1
- +3 NEW X
- SET X=$PIECE($GET(^PS(53.1,ON,.2)),U,4)
- SET X=$SELECT(X="S":1,X="A":2,X="R":3,X="P":4,1:5)
- +4 SET PSJCOM=$PIECE($GET(^PS(53.1,ON,.2)),U,8)
- IF PSJCOM
- if '$$COMCHK^PSJO1(PSJCOM,2)
- QUIT
- if PSJCOM=PSJCOM1
- QUIT
- +5 NEW CLIN,CLINSORT,SORT,PSIVSTAT,CLINSORT
- SET PSIVSTAT=$SELECT('PSJCOM:"P",1:"PD")
- +6 SET CLIN=$$CLINIC^PSJO1(PSGP,ON_"P")
- IF $LENGTH(CLIN)>1
- SET CLINSORT=$$CLINSORT^PSJO1("P")
- SET PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT
- +7 IF $GET(^PS(53.1,ON,0))
- IF $PIECE(^PS(53.1,ON,0),U,4)'="U"
- SET ^TMP("PSIV",$JOB,PSIVSTAT,X_9999999999-ON)=""
- End DoDot:1
- SET PSJCOM1=PSJCOM
- +8 FOR ON=0:0
- SET ON=$ORDER(^PS(53.1,"AS","N",DFN,ON))
- if 'ON
- QUIT
- Begin DoDot:1
- +9 NEW X
- SET X=$PIECE($GET(^PS(53.1,ON,.2)),U,4)
- SET X=$SELECT(X="S":1,X="A":2,X="R":3,X="P":4,1:5)
- +10 SET PSJCOM=$PIECE($GET(^PS(53.1,ON,.2)),U,8)
- IF PSJCOM
- if '$$COMCHK^PSJO1(PSJCOM,2)
- QUIT
- if PSJCOM=PSJCOM1
- QUIT
- +11 NEW CLIN,PSIVSTAT,CLINSORT,SORT
- SET PSIVSTAT=$SELECT('PSJCOM:"N",1:"ND")
- +12 SET CLIN=$$CLINIC^PSJO1(PSGP,ON_"P")
- IF (CLIN]"")
- SET CLINSORT=$$CLINSORT^PSJO1("P")
- SET PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_$SELECT('PSJCOM:"N",1:"ND")
- +13 IF $GET(^PS(53.1,ON,0))
- IF $PIECE(^PS(53.1,ON,0),U,4)'="U"
- SET ^TMP("PSIV",$JOB,PSIVSTAT,X_9999999999-ON)=""
- +14 ; S:$P(^PS(53.1,ON,0),U,4)'="U" ^TMP("PSIV",$J,"P",X_9999999999-ON)=""
- End DoDot:1
- SET PSJCOM1=PSJCOM
- +15 ;
- QUIT ; Kill and exit.
- +1 KILL PSIVCWD,PSIVFLAG,PSIVWD,PSDFN,PSON1,PSFDT,YHOLD,JJ,XHOLD
- +2 QUIT
- +3 ;
- SETP ; Get partial P array,
- +1 SET ON=ON_"V"
- SET Y=$GET(^PS(55,DFN,"IV",+ON,0))
- FOR X=2,3,17,21
- SET P(X)=$PIECE(Y,U,X)
- +2 SET P(2)=+P(2)
- SET P(3)=+P(3)
- SET Y(P(2))=""
- SET Y(P(3))=""
- +3 IF P(2)
- IF P(3)
- IF P(17)'="P"
- DO CHK
- +4 QUIT
- +5 ;
- CHK ; Check if order is active or expired and save accordingly.
- +1 ;373 added PSGP
- NEW CLIN,PSIVSTAT,CLINSORT,SORT
- SET PSIVSTAT="A"
- SET PSGP=DFN
- +2 SET CLIN=$$CLINIC^PSJO1(PSGP,ON)
- IF CLIN]""
- SET CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT)
- SET PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^A"
- +3 SET PS=PS+1
- IF P(17)="H"
- SET ^TMP("PSIV",$JOB,PSIVSTAT,9999999999-ON)=""
- QUIT
- +4 IF $ORDER(Y(PSFDT))=P(3)
- DO ACTO
- QUIT
- +5 IF $ORDER(Y(PSFDT))=""
- DO NACTO
- QUIT
- +6 if "ARO"[P(17)
- SET ^TMP("PSIV",$JOB,PSIVSTAT,9999999999-ON)=""
- if "ED"[P(17)
- SET ^TMP("PSIV",$JOB,"X",9999999999-ON)=""
- if "E"[P(17)
- SET PSIVREA="A"
- SET $PIECE(^PS(55,DFN,"IV",+ON,0),U,17)="A"
- SET PS("A",9999999999-ON)=""
- +7 QUIT
- +8 ;
- ACTO ; Active orders
- +1 ;I "AE"[P(17) S ^TMP("PSIV",$J,"A",9999999999-ON)="" S:P(17)="E" $P(^PS(55,DFN,"IV",+ON,0),U,17)="A" Q ;;mv-not sure why setting status back to "A"???
- +2 ;added PSGP #373
- NEW CLINSORT,SORT,CLIN,PSIVSTAT
- SET PSIVSTAT="A"
- SET PSGP=DFN
- +3 SET CLIN=$$CLINIC^PSJO1(PSGP,ON)
- IF (CLIN]"")
- SET CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT)
- SET PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^A"
- +4 IF ($PIECE(PSIVSTAT,"^")="Cz")
- if ("DE"[P(17))
- SET PSIVSTAT="RD"
- SET ^TMP("PSIV",$JOB,PSIVSTAT,9999999999-ON)=""
- QUIT
- +5 IF "A"[P(17)
- SET ^TMP("PSIV",$JOB,PSIVSTAT,9999999999-ON)=""
- QUIT
- +6 IF "HOR"[P(17)
- SET ^TMP("PSIV",$JOB,PSIVSTAT,9999999999-ON)=""
- QUIT
- +7 IF "DE"[P(17)
- SET ^TMP("PSIV",$JOB,"RD",9999999999-ON)=""
- +8 QUIT
- +9 ;
- NACTO ; Inactive orders
- +1 ;I "AER"[P(17) S ^TMP("PSIV",$J,"X",9999999999-ON)="" I "AR"[P(17) S $P(^PS(55,DFN,"IV",+ON,0),U,17)="E" D EXPIR^PSIVOE Q
- +2 ;added PSGP #373
- NEW CLIN,PSIVSTAT,SORT,CLINSORT
- SET PSIVSTAT=""
- SET PSGP=DFN
- +3 SET CLIN=$$CLINIC^PSJO1(PSGP,ON)
- +4 IF "AER"[P(17)
- Begin DoDot:1
- +5 if $PIECE(^PS(55,DFN,"IV",+ON,0),U,3)=""
- QUIT
- SET PSIVSTAT="A"
- +6 IF +PSJSYSU=3
- IF ($PIECE($GET(^PS(55,DFN,"IV",+ON,.2)),U,4)="D")
- IF '+$PIECE($GET(^(4)),U,4)
- Begin DoDot:2
- +7 IF (CLIN]"")
- SET CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT)
- SET PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT
- +8 SET ^TMP("PSIV",$JOB,PSIVSTAT,9999999999-ON)=""
- End DoDot:2
- QUIT
- +9 SET PSIVSTAT="X"
- if (CLIN]"")
- SET CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT)
- if ($GET(CLINSORT)]"")
- SET PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT
- Begin DoDot:2
- +10 SET ^TMP("PSIV",$JOB,PSIVSTAT,9999999999-ON)=""
- End DoDot:2
- End DoDot:1
- +11 IF "AR"[P(17)
- SET $PIECE(^PS(55,DFN,"IV",+ON,0),U,17)="E"
- DO EXPIR^PSIVOE
- +12 IF "OD"[P(17)
- SET PSIVSTAT="X"
- if (CLIN]"")
- SET CLINSORT=$$CLINSORT^PSJO1(PSIVSTAT)
- if ($GET(CLINSORT)]"")
- SET PSIVSTAT="Cz^"_CLIN_"^"_CLINSORT_"^"_PSIVSTAT
- Begin DoDot:1
- +13 SET ^TMP("PSIV",$JOB,PSIVSTAT,9999999999-ON)=""
- End DoDot:1
- +14 QUIT
- +15 ;
- DCOR ; Auto-cancel IV orders
- +1 ;NEED TO NEW VARIABLES LATER.
- +2 NEW DA,DIR,DG,ON,ON55,P,PSIVAC,PSIVACT,PSIVLN,PSIVREA,PSIVRES,PSGALO,PSGP,PSJDCDT,PSJIVDCF,PSJIVON,PSJIVORF,PSJORF,VA,VADM,VAERR
- +3 SET PSGP=DFN
- SET PSIVRES="Auto DC due to Surgery Package"
- +4 DO NOW^%DTC
- SET PSJDCDT=+%
- +5 DO ENIV^PSJADT0
- +6 QUIT