PSJCLOR4 ;BIR/JCH - INPATIENT MEDICATIONS PROFILE FOR CLINIC ORDERS ;25 SEP 97 / 7:43 AM
;;5.0;INPATIENT MEDICATIONS;**275**;16 DEC 97;Build 157
;
; Reference to ^PS(55 is supported by DBIA# 2191
;
N PFLG,PSJNEW,PSGPTMP,PPAGE,QFLG S PSJNEW=1
N PSGLI,PSGWD,PSJAT,PSJPNRB,PSJPWDO,PSJSTOP,PSJTEAM
;
EN ;
G:$D(XQUIT) DONE
D @$S('$D(PSJEXTP):"^PSIVXU",1:"ENCV^PSGSETU")
G:$D(XQUIT) DONE S PSGPTMP=0,PPAGE=1 K PSJSEL D @$S($D(PSJEXTP):"P^PSJPDIR",1:"GWP^PSJPDIR") G:$G(PSJSTOP)=1 DONE S:$D(PSJEXTP) PSJSEL("SELECT")="P"
I $G(PSJSEL("WG"))="^OTHER",PSJSEL("SELECT")="G",PSJSTOP=2 S PSJSEL("SELECT")="C",PSJSEL("RBP")="P"
D ENL^PSJO3 G:"^N"[PSJOL EN D GO
;
DONE ;
K ^TMP("PSJON",$J),^TMP("PSJ",$J)
D ENIVKV^PSGSETU K AND,AT,C,CA,DDH,DFN,DN,DOB,DRGI,DRGN,DRGT,FIL,FQC,HDR,I1,J,JJ,MF,NF,O,OD,ON,ON55,P,P1,PDRG,PG,PPN,PRI,PRIV,PSGLMT,PSGOE,PSGONC,PSGONR,PSGONV,PSGORD,PSGSS,PSGSSH,PSGON,PSGPR,PSGPRP
K PSIVAC,PSIVCT,PSIVREA,PSIVSCR,PSIVUP,PSIVX,CLINIC,JDFN,POP,PSGTIR,PSJEXTP,PSJNKF,DTOUT,DUOUT,Q,STDTE,X,Y,ZTDESC
K PSJACNWP,PSJACOK,PSJDEV,PSJDBL,PSJION,PSJON,PSJOS,PSJP,PSJSEL,PSJSS,PSJSSH,PSJPRW,PSJPRWN,PSJPRWG,PSJPRWGN
K PSJOPC,PSJORD,PSJQ,PSJIVOF,PSJOCNT,PSJPR,PSJPRA,PSJPRF,PSJPRP,PSJON,PSJS1,PSJS2,PSJS3,PSJS4,PSJPR,PX,HDT,PSGODT,RF,SD,SLS,SSN,TF,UD,WD,WDP,WT,PSJORIFN,RB,RCT,SUB,XQUIT,ZTOUT
Q
;
GO ;
S PSJPRP="P",PSJPRA="" G:PSJSEL("SELECT")'="P" DEV
N DIR S DIR(0)="SAO^P:PROFILE;E:EXPANDED VIEWS;B:BOTH",DIR("A")="Show PROFILE only, EXPANDED VIEWS only, or BOTH: ",DIR("B")="PROFILE",DIR("?")="^D PH^PSJPR" W ! D ^DIR G:"^"[Y EN S PSJPRP=Y
I "EB"[PSJPRP F R !!,"Show SHORT, LONG, or NO activity log? NO// ",AT:DTIME D ALC^PSGVW0 I Q S PSJPRA=AT Q
G:PSJPRA="^" EN
DEV ;
S PSJOS=$P(PSJSYSP0,"^",11)
K ZTSAVE S PSGTIR="ENQ^PSJCLOR4",ZTDESC="INPATIENT PATIENT PROFILE" F X="DFN","PSJSEL(","PSJOL","PSJOS","PSJPRA","PSJPRP","PSGPTMP","PPAGE","PSJEXTP","PSJHDATE" S ZTSAVE(X)=""
D ENQ
K DIR S DIR(0)="YO",DIR("A")="Print this profile to a printer",DIR("B")="N" D ^DIR I $G(Y) D ENDEV^PSGTI Q:POP D:'$D(IO("Q")) ENQ
Q
;
ENQ ;
S Y="PSJPR" F X="W","WG" S:$D(PSJSEL(X)) @(Y_X)=+PSJSEL(X),@(Y_X_"N")=$P(PSJSEL(X),U,2)
S PSJACNWP=1 K ^TMP("PSJAT",$J) S PSJPR=IO'=IO(0)!($E(IOST)'="C"),PSGPRP=PSJPRP
I PSJSEL("SELECT")="P" S PPN="" F S PPN=$O(PSJSEL("P",PPN)) Q:PPN="" D Q:$G(X)?1"^"."^"
.F DFN=0:0 S (PSGP,DFN)=$O(PSJSEL("P",PPN,DFN)) Q:'DFN D ENBOTH^PSJAC,PP Q:$G(X)?1"^"."^"
D:PSJSEL("SELECT")'="P" @("P"_PSJSEL("SELECT")) I PSJPR W:$Y @IOF D ^%ZISC,DONE
Q
PC ;
K ^TMP("PSJPR",$J,"OUTPAT")
S (STDTE,CLINIC,JDFN)=0
F S STDTE=$O(^PS(55,"AIVC",STDTE)) Q:STDTE="" F S CLINIC=$O(^PS(55,"AIVC",STDTE,CLINIC)) Q:CLINIC="" D
. F S JDFN=$O(^PS(55,"AIVC",STDTE,CLINIC,JDFN)) Q:JDFN="" I '$D(^TMP("PSJPR",$J,"OUTPAT",JDFN)) S DFN=JDFN K ^TMP("PSJAT",$J) D PAT,PAT1,PJ
S (STDTE,CLINIC,JDFN)=0
F S STDTE=$O(^PS(55,"AUDC",STDTE)) Q:STDTE="" F S CLINIC=$O(^PS(55,"AIVC",STDTE,CLINIC)) Q:CLINIC="" D
. F S JDFN=$O(^PS(55,"AUDC",STDTE,CLINIC,JDFN)) Q:JDFN="" I '$D(^TMP("PSJPR",$J,"OUTPAT",JDFN)) S DFN=JDFN K ^TMP("PSJAT",$J) D PAT,PAT1,PJ
Q
PJ ;
S ^TMP("PSJPR",$J,"OUTPAT",JDFN)=""
PG ;
F PSJPRW=0:0 S PSJPRW=$O(^PS(57.5,"AC",PSJPRWG,PSJPRW)) Q:'PSJPRW S PSJPRWN=$P($G(^DIC(42,+PSJPRW,0)),"^") I PSJPRWN]"" D PW Q:$G(X)="^"
Q
PW ;
K ^TMP("PSJAT",$J) F DFN=0:0 S (DFN,PSGP)=$O(^DPT("CN",PSJPRWN,DFN)) Q:'DFN D PAT
D PAT1
Q
PAT ;
S RB=$P($G(^DPT(DFN,.101)),U),PPN=$P($G(^(0)),U),X=$S(PSJSEL("RBP")="R":RB,1:PPN),AT=""
I $D(PSJSEL("TM")) S:RB]"" AT=$O(^PS(57.7,"AWRT",PSJPRW,RB,0)) Q:$S($D(PSJSEL("TM","ALL")):0,AT="":1,1:'$D(PSJSEL("TM",AT)))
F Y="AT","RB","X" S:@Y="" @Y="ZZ"
S ^TMP("PSJAT",$J,AT,X,DFN)=""
Q
PAT1 ;
K PSJDBL S PSJAT="" F S PSJAT=$O(^TMP("PSJAT",$J,PSJAT)) Q:PSJAT=""!$G(PSJDBL) D
.S PSJPNRB="" F S PSJPNRB=$O(^TMP("PSJAT",$J,PSJAT,PSJPNRB)) Q:PSJPNRB="" S (DFN,PSGP)=+$O(^TMP("PSJAT",$J,PSJAT,PSJPNRB,0)) D ENBOTH^PSJAC,PP I $G(X)["^" S:X="^^" PSJDBL=1 Q
Q
PP ;
I PSJPRP'="E" D ^PSJO I PSJPRP="P",'PSJPR D:'PSJON READ^PSJUTL Q:$G(X)?1"^"."^" I PSJON S PSJPRF=1 D ENVW^PSJOE0 K PSGPRF Q
Q:PSJPRP="P" I PSJPRP="E" U IO S PSJON=0,PSJDEV=PSJPR D @$S($D(PSJEXTP):"EN^PSJH1,ENGET^PSJO3",1:"EN^PSJO1(3),ENGET^PSJO3")
I 'PSJPR,PSJSEL("SELECT")'="P",'$D(^TMP("PSG",$J)) D READ^PSJUTL Q
I PSJPRP'="E",'PSJPR D PP3 Q:$D(DUOUT)!$D(DTOUT)
S (PSJS1,PSJS2,PSJS3,PSJS4,X)=""
F PSJQ=0:0 S PSJS1=$O(^TMP("PSJ",$J,PSJS1)) Q:PSJS1="" F PSJQ=0:0 S PSJS2=$O(^TMP("PSJ",$J,PSJS1,PSJS2)) Q:PSJS2="" F PSJQ=0:0 S PSJS3=$O(^TMP("PSJ",$J,PSJS1,PSJS2,PSJS3)) Q:PSJS3="" D PP1
D:X'["^"&PSJPR BOT^PSJO3 K ^TMP("PSJ",$J) Q
PP1 ;
F PSJQ=0:0 S PSJS4=$O(^TMP("PSJ",$J,PSJS1,PSJS2,PSJS3,PSJS4)) Q:PSJS4="" D PP2
Q
;
PP2 ; Display selected order.
N PSJPRF,PSJLM S PSJORD=PSJS4 I $S(PSJORD["V":1,PSJORD["P":$P($G(^PS(53.1,+PSJORD,0)),U,4)="F",1:0) D Q
.S PSJPRF=1 D ENINP^PSIVOPT(PSGP,PSJORD),PP3 Q:$D(DUOUT)!$D(DTOUT) I PSJPRA'="N" I PSJORD'["P" D ENLOG^PSIVVW1,PP3 Q
S PSGORD=PSJORD D EN2^PSGVW,PP3 Q:$D(DUOUT)!$D(DTOUT) I PSJPRA'="N",((PSJS1["A")!(PSJS1["O")) S AT=PSJPRA D ENA^PSGVW0 D PP3
Q
PP3 S X="" I 'PSJPR K DIR S DIR(0)="E" D ^DIR S:$D(DUOUT)!$D(DTOUT) X="^" I X["^" S (PSJS1,PSJS2,PSJS3,PSJS4)="~"
Q
;
PH ;
W !!?2,"Enter a 'P' to print ONLY the PROFILE of orders for this patient. Enter an",!,"'E' to print ONLY the EXPANDED VIEW of the orders for this patient. Enter a",!,"'B' to have BOTH the profile (first) and the expanded views print."
W " Enter an '^'to exit." Q
;
ENOR(PSGP) ;S (PSGP,DFN)=+ORVP,PSGP(0)=^DPT(PSGP,0)
S DFN=+PSGP,PSGP(0)=^DPT(PSGP,0)
ENLM N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
S PSGPTMP=0,PPAGE=1
D ENCV^PSGSETU
D ENBOTH^PSJAC D:$D(PSJEXTP) CNV^PSJP D ENL^PSJO3 I "^N"'[PSJOL S PSJSEL("SELECT")="P",PSJSEL("P",PSGP(0),PSGP)="",(PSJPRW,PSJPRWG)=0,(PSJPRWN,PSJPRWGN)="",XQUIT="YES" D GO
;* S PSJNKF=1 D READ^PSJUTL G DONE
S PSJNKF=1 G DONE
Q
;
A34 ; Stop date Active Unit Dose
S MSG=0,PSGF2=34
K PSGFDX
I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D Q
. W !!?5,"Stop Date/Time may not be edited for active complex orders." D PAUSE^VALM1
. D A34DONE
W !,"STOP DATE/TIME: "_$S($P(PSGFDN,"^")]"":$P(PSGFDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 D A34DONE Q
I X="",PSGFD W " "_$P(PSGFDN,"^") G W34
I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A34
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,34)
I X=+X,(X>0),(X'>2000000) G A34:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X W " ...dose limit..." D ENE^PSGDL
K %DT S %DT="ERTX",%DT(0)=PSGSD D ^%DT K %DT G:Y'>0 A34 S (PSGFDX,PSGFD)=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
W34 ;Compare to Start Date
N Z,MSG
D DOSE^PSGOE91 I $G(Z)]"",Z>$S($G(PSGFD):PSGFD,1:$G(PSGNEFD)) D G A34
. S MSG(1)="There is no administration time that falls between the Start Date/Time"
. S MSG(2)="and the Stop Date/Time."
. D EN^DDIOL(.MSG)
I PSGFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",! S MSG=1
Q
A34DONE ; clean up Active UD Stop Date vars
K MSG
Q
A25NV ; Stop Date Non-Verified
K PSGFDX
W !,"STOP DATE/TIME: "_$S($P(PSGFDN,"^")]"":$P(PSGFDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G A25DONE
I X="",PSGFD S X=$P(PSGFDN,"^") ;W " "_$P(PSGFDN,"^")
I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A25NV
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,25)
I X=+X,(X>0),(X'>2000000) G A25NV:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X W " ...dose limit..." D ENE^PSGDL
K %DT S %DT="ERTX",%DT(0)=PSGSD D ^%DT K %DT G:Y'>0 A25NV S (PSGFDX,PSGFD,PSGNEFD)=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
W25 ; Loop Stop Date NV
N Z,MSG
D DOSE^PSGOE81 I $G(Z)]"",Z>PSGNEFD D G A25NV
. S MSG(1)="There is no administration time that falls between the Start Date/Time"
. S MSG(2)="and the Stop Date/Time."
. D EN^DDIOL(.MSG)
I PSGFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",! G A25NV
Q
A25DONE ; NV Stop Date Done
D EFDNV^PSJUTL
K MSG
Q
A25V(DFN,ON) ; Stop Date Active IV
N X,TMPY,DIR
A25V2 ; IV Stop Date Continued
I P("IVRM")]"",$S(P(3)<P(2):1,$G(PSIVAC)["E":0,1:1) S PSIVSITE=$G(^PS(59.5,+P("IVRM"),1)),$P(PSIVSITE,"^",20,21)=$G(^PS(59.5,+P("IVRM"),5)) D ENSTOP^PSIVCAL
I $G(ON)["V"!($G(ON)["U") I $$COMPLEX^PSJOE(DFN,ON) D Q
.Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Stop Date may not be edited at this point." D PAUSE^VALM1
S Y=P(3) X ^DD("DD") W !,"STOP DATE/TIME: "_$S(Y]"":Y_"// ",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 Q:X=""&P(2) I $E(X)=U!(X=""&P(2)) Q
I X="@"!(X["?") W $C(7)," (Required)" S F1=53.1,F2=25,X="?" D ENHLP^PSIVORC1 G A25V2
K %DT S:X="" X=$G(Y) S:X="" X=P(3) S %DT="TE" D:X'=+X ^%DT
I X=+X,X>0,X'>2000000 G A25V2:'$$ENDL^PSGDL(P(9),X) D ENDL^PSIVSP
S TMPY=Y I TMPY["^" S PSJQMSG=0 Q
I $E(TMPY)="?" K DIR,X,Y D ENHLP^PSGOEM(55.06,10) S PSJQMSG=1 G A25V2
I TMPY'["." W $C(7),!?5," Time is REQUIRED. Re-enter Start Date. " S PSJQMSG=1 G A25V2
D DOSE^PSIVEDT1
I $G(X)="" S X=Y
I $G(X)="" S X=P(3)
I $G(Z)]"",Z>X D G A25V2
. W !,"There is no administration time that falls between the Start Date/Time"
. W !,"and Stop Date/Time.",!
S X=Y S:Y<1!Y'["." X="" G:Y'>0 A25V2 S P(3)=+Y,PSGFDX=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJCLOR4 9378 printed Sep 23, 2025@19:42:33 Page 2
PSJCLOR4 ;BIR/JCH - INPATIENT MEDICATIONS PROFILE FOR CLINIC ORDERS ;25 SEP 97 / 7:43 AM
+1 ;;5.0;INPATIENT MEDICATIONS;**275**;16 DEC 97;Build 157
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA# 2191
+4 ;
+5 NEW PFLG,PSJNEW,PSGPTMP,PPAGE,QFLG
SET PSJNEW=1
+6 NEW PSGLI,PSGWD,PSJAT,PSJPNRB,PSJPWDO,PSJSTOP,PSJTEAM
+7 ;
EN ;
+1 if $DATA(XQUIT)
GOTO DONE
+2 DO @$SELECT('$DATA(PSJEXTP):"^PSIVXU",1:"ENCV^PSGSETU")
+3 if $DATA(XQUIT)
GOTO DONE
SET PSGPTMP=0
SET PPAGE=1
KILL PSJSEL
DO @$SELECT($DATA(PSJEXTP):"P^PSJPDIR",1:"GWP^PSJPDIR")
if $GET(PSJSTOP)=1
GOTO DONE
if $DATA(PSJEXTP)
SET PSJSEL("SELECT")="P"
+4 IF $GET(PSJSEL("WG"))="^OTHER"
IF PSJSEL("SELECT")="G"
IF PSJSTOP=2
SET PSJSEL("SELECT")="C"
SET PSJSEL("RBP")="P"
+5 DO ENL^PSJO3
if "^N"[PSJOL
GOTO EN
DO GO
+6 ;
DONE ;
+1 KILL ^TMP("PSJON",$JOB),^TMP("PSJ",$JOB)
+2 DO ENIVKV^PSGSETU
KILL AND,AT,C,CA,DDH,DFN,DN,DOB,DRGI,DRGN,DRGT,FIL,FQC,HDR,I1,J,JJ,MF,NF,O,OD,ON,ON55,P,P1,PDRG,PG,PPN,PRI,PRIV,PSGLMT,PSGOE,PSGONC,PSGONR,PSGONV,PSGORD,PSGSS,PSGSSH,PSGON,PSGPR,PSGPRP
+3 KILL PSIVAC,PSIVCT,PSIVREA,PSIVSCR,PSIVUP,PSIVX,CLINIC,JDFN,POP,PSGTIR,PSJEXTP,PSJNKF,DTOUT,DUOUT,Q,STDTE,X,Y,ZTDESC
+4 KILL PSJACNWP,PSJACOK,PSJDEV,PSJDBL,PSJION,PSJON,PSJOS,PSJP,PSJSEL,PSJSS,PSJSSH,PSJPRW,PSJPRWN,PSJPRWG,PSJPRWGN
+5 KILL PSJOPC,PSJORD,PSJQ,PSJIVOF,PSJOCNT,PSJPR,PSJPRA,PSJPRF,PSJPRP,PSJON,PSJS1,PSJS2,PSJS3,PSJS4,PSJPR,PX,HDT,PSGODT,RF,SD,SLS,SSN,TF,UD,WD,WDP,WT,PSJORIFN,RB,RCT,SUB,XQUIT,ZTOUT
+6 QUIT
+7 ;
GO ;
+1 SET PSJPRP="P"
SET PSJPRA=""
if PSJSEL("SELECT")'="P"
GOTO DEV
+2 NEW DIR
SET DIR(0)="SAO^P:PROFILE;E:EXPANDED VIEWS;B:BOTH"
SET DIR("A")="Show PROFILE only, EXPANDED VIEWS only, or BOTH: "
SET DIR("B")="PROFILE"
SET DIR("?")="^D PH^PSJPR"
WRITE !
DO ^DIR
if "^"[Y
GOTO EN
SET PSJPRP=Y
+3 IF "EB"[PSJPRP
FOR
READ !!,"Show SHORT, LONG, or NO activity log? NO// ",AT:DTIME
DO ALC^PSGVW0
IF Q
SET PSJPRA=AT
QUIT
+4 if PSJPRA="^"
GOTO EN
DEV ;
+1 SET PSJOS=$PIECE(PSJSYSP0,"^",11)
+2 KILL ZTSAVE
SET PSGTIR="ENQ^PSJCLOR4"
SET ZTDESC="INPATIENT PATIENT PROFILE"
FOR X="DFN","PSJSEL(","PSJOL","PSJOS","PSJPRA","PSJPRP","PSGPTMP","PPAGE","PSJEXTP","PSJHDATE"
SET ZTSAVE(X)=""
+3 DO ENQ
+4 KILL DIR
SET DIR(0)="YO"
SET DIR("A")="Print this profile to a printer"
SET DIR("B")="N"
DO ^DIR
IF $GET(Y)
DO ENDEV^PSGTI
if POP
QUIT
if '$DATA(IO("Q"))
DO ENQ
+5 QUIT
+6 ;
ENQ ;
+1 SET Y="PSJPR"
FOR X="W","WG"
if $DATA(PSJSEL(X))
SET @(Y_X)=+PSJSEL(X)
SET @(Y_X_"N")=$PIECE(PSJSEL(X),U,2)
+2 SET PSJACNWP=1
KILL ^TMP("PSJAT",$JOB)
SET PSJPR=IO'=IO(0)!($EXTRACT(IOST)'="C")
SET PSGPRP=PSJPRP
+3 IF PSJSEL("SELECT")="P"
SET PPN=""
FOR
SET PPN=$ORDER(PSJSEL("P",PPN))
if PPN=""
QUIT
Begin DoDot:1
+4 FOR DFN=0:0
SET (PSGP,DFN)=$ORDER(PSJSEL("P",PPN,DFN))
if 'DFN
QUIT
DO ENBOTH^PSJAC
DO PP
if $GET(X)?1"^"."^"
QUIT
End DoDot:1
if $GET(X)?1"^"."^"
QUIT
+5 if PSJSEL("SELECT")'="P"
DO @("P"_PSJSEL("SELECT"))
IF PSJPR
if $Y
WRITE @IOF
DO ^%ZISC
DO DONE
+6 QUIT
PC ;
+1 KILL ^TMP("PSJPR",$JOB,"OUTPAT")
+2 SET (STDTE,CLINIC,JDFN)=0
+3 FOR
SET STDTE=$ORDER(^PS(55,"AIVC",STDTE))
if STDTE=""
QUIT
FOR
SET CLINIC=$ORDER(^PS(55,"AIVC",STDTE,CLINIC))
if CLINIC=""
QUIT
Begin DoDot:1
+4 FOR
SET JDFN=$ORDER(^PS(55,"AIVC",STDTE,CLINIC,JDFN))
if JDFN=""
QUIT
IF '$DATA(^TMP("PSJPR",$JOB,"OUTPAT",JDFN))
SET DFN=JDFN
KILL ^TMP("PSJAT",$JOB)
DO PAT
DO PAT1
DO PJ
End DoDot:1
+5 SET (STDTE,CLINIC,JDFN)=0
+6 FOR
SET STDTE=$ORDER(^PS(55,"AUDC",STDTE))
if STDTE=""
QUIT
FOR
SET CLINIC=$ORDER(^PS(55,"AIVC",STDTE,CLINIC))
if CLINIC=""
QUIT
Begin DoDot:1
+7 FOR
SET JDFN=$ORDER(^PS(55,"AUDC",STDTE,CLINIC,JDFN))
if JDFN=""
QUIT
IF '$DATA(^TMP("PSJPR",$JOB,"OUTPAT",JDFN))
SET DFN=JDFN
KILL ^TMP("PSJAT",$JOB)
DO PAT
DO PAT1
DO PJ
End DoDot:1
+8 QUIT
PJ ;
+1 SET ^TMP("PSJPR",$JOB,"OUTPAT",JDFN)=""
PG ;
+1 FOR PSJPRW=0:0
SET PSJPRW=$ORDER(^PS(57.5,"AC",PSJPRWG,PSJPRW))
if 'PSJPRW
QUIT
SET PSJPRWN=$PIECE($GET(^DIC(42,+PSJPRW,0)),"^")
IF PSJPRWN]""
DO PW
if $GET(X)="^"
QUIT
+2 QUIT
PW ;
+1 KILL ^TMP("PSJAT",$JOB)
FOR DFN=0:0
SET (DFN,PSGP)=$ORDER(^DPT("CN",PSJPRWN,DFN))
if 'DFN
QUIT
DO PAT
+2 DO PAT1
+3 QUIT
PAT ;
+1 SET RB=$PIECE($GET(^DPT(DFN,.101)),U)
SET PPN=$PIECE($GET(^(0)),U)
SET X=$SELECT(PSJSEL("RBP")="R":RB,1:PPN)
SET AT=""
+2 IF $DATA(PSJSEL("TM"))
if RB]""
SET AT=$ORDER(^PS(57.7,"AWRT",PSJPRW,RB,0))
if $SELECT($DATA(PSJSEL("TM","ALL"))
QUIT
+3 FOR Y="AT","RB","X"
if @Y=""
SET @Y="ZZ"
+4 SET ^TMP("PSJAT",$JOB,AT,X,DFN)=""
+5 QUIT
PAT1 ;
+1 KILL PSJDBL
SET PSJAT=""
FOR
SET PSJAT=$ORDER(^TMP("PSJAT",$JOB,PSJAT))
if PSJAT=""!$GET(PSJDBL)
QUIT
Begin DoDot:1
+2 SET PSJPNRB=""
FOR
SET PSJPNRB=$ORDER(^TMP("PSJAT",$JOB,PSJAT,PSJPNRB))
if PSJPNRB=""
QUIT
SET (DFN,PSGP)=+$ORDER(^TMP("PSJAT",$JOB,PSJAT,PSJPNRB,0))
DO ENBOTH^PSJAC
DO PP
IF $GET(X)["^"
if X="^^"
SET PSJDBL=1
QUIT
End DoDot:1
+3 QUIT
PP ;
+1 IF PSJPRP'="E"
DO ^PSJO
IF PSJPRP="P"
IF 'PSJPR
if 'PSJON
DO READ^PSJUTL
if $GET(X)?1"^"."^"
QUIT
IF PSJON
SET PSJPRF=1
DO ENVW^PSJOE0
KILL PSGPRF
QUIT
+2 if PSJPRP="P"
QUIT
IF PSJPRP="E"
USE IO
SET PSJON=0
SET PSJDEV=PSJPR
DO @$SELECT($DATA(PSJEXTP):"EN^PSJH1,ENGET^PSJO3",1:"EN^PSJO1(3),ENGET^PSJO3")
+3 IF 'PSJPR
IF PSJSEL("SELECT")'="P"
IF '$DATA(^TMP("PSG",$JOB))
DO READ^PSJUTL
QUIT
+4 IF PSJPRP'="E"
IF 'PSJPR
DO PP3
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+5 SET (PSJS1,PSJS2,PSJS3,PSJS4,X)=""
+6 FOR PSJQ=0:0
SET PSJS1=$ORDER(^TMP("PSJ",$JOB,PSJS1))
if PSJS1=""
QUIT
FOR PSJQ=0:0
SET PSJS2=$ORDER(^TMP("PSJ",$JOB,PSJS1,PSJS2))
if PSJS2=""
QUIT
FOR PSJQ=0:0
SET PSJS3=$ORDER(^TMP("PSJ",$JOB,PSJS1,PSJS2,PSJS3))
if PSJS3=""
QUIT
DO PP1
+7 if X'["^"&PSJPR
DO BOT^PSJO3
KILL ^TMP("PSJ",$JOB)
QUIT
PP1 ;
+1 FOR PSJQ=0:0
SET PSJS4=$ORDER(^TMP("PSJ",$JOB,PSJS1,PSJS2,PSJS3,PSJS4))
if PSJS4=""
QUIT
DO PP2
+2 QUIT
+3 ;
PP2 ; Display selected order.
+1 NEW PSJPRF,PSJLM
SET PSJORD=PSJS4
IF $SELECT(PSJORD["V":1,PSJORD["P":$PIECE($GET(^PS(53.1,+PSJORD,0)),U,4)="F",1:0)
Begin DoDot:1
+2 SET PSJPRF=1
DO ENINP^PSIVOPT(PSGP,PSJORD)
DO PP3
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
IF PSJPRA'="N"
IF PSJORD'["P"
DO ENLOG^PSIVVW1
DO PP3
QUIT
End DoDot:1
QUIT
+3 SET PSGORD=PSJORD
DO EN2^PSGVW
DO PP3
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
IF PSJPRA'="N"
IF ((PSJS1["A")!(PSJS1["O"))
SET AT=PSJPRA
DO ENA^PSGVW0
DO PP3
+4 QUIT
PP3 SET X=""
IF 'PSJPR
KILL DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DUOUT)!$DATA(DTOUT)
SET X="^"
IF X["^"
SET (PSJS1,PSJS2,PSJS3,PSJS4)="~"
+1 QUIT
+2 ;
PH ;
+1 WRITE !!?2,"Enter a 'P' to print ONLY the PROFILE of orders for this patient. Enter an",!,"'E' to print ONLY the EXPANDED VIEW of the orders for this patient. Enter a",!,"'B' to have BOTH the profile (first) and the expanded views print."
+2 WRITE " Enter an '^'to exit."
QUIT
+3 ;
ENOR(PSGP) ;S (PSGP,DFN)=+ORVP,PSGP(0)=^DPT(PSGP,0)
+1 SET DFN=+PSGP
SET PSGP(0)=^DPT(PSGP,0)
ENLM NEW PSJNEW,PSGPTMP,PPAGE
SET PSJNEW=1
+1 SET PSGPTMP=0
SET PPAGE=1
+2 DO ENCV^PSGSETU
+3 DO ENBOTH^PSJAC
if $DATA(PSJEXTP)
DO CNV^PSJP
DO ENL^PSJO3
IF "^N"'[PSJOL
SET PSJSEL("SELECT")="P"
SET PSJSEL("P",PSGP(0),PSGP)=""
SET (PSJPRW,PSJPRWG)=0
SET (PSJPRWN,PSJPRWGN)=""
SET XQUIT="YES"
DO GO
+4 ;* S PSJNKF=1 D READ^PSJUTL G DONE
+5 SET PSJNKF=1
GOTO DONE
+6 QUIT
+7 ;
A34 ; Stop date Active Unit Dose
+1 SET MSG=0
SET PSGF2=34
+2 KILL PSGFDX
+3 IF $GET(PSJORD)
IF $GET(PSGP)
IF $$COMPLEX^PSJOE(PSGP,PSJORD)
SET PSGOEE=0
Begin DoDot:1
+4 WRITE !!?5,"Stop Date/Time may not be edited for active complex orders."
DO PAUSE^VALM1
+5 DO A34DONE
End DoDot:1
QUIT
+6 WRITE !,"STOP DATE/TIME: "_$SELECT($PIECE(PSGFDN,"^")]"":$PIECE(PSGFDN,"^")_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
if '$TEST
WRITE $CHAR(7)
SET PSGOEE=0
DO A34DONE
QUIT
+7 IF X=""
IF PSGFD
WRITE " "_$PIECE(PSGFDN,"^")
GOTO W34
+8 IF $EXTRACT(X)="^"
DO ENFF^PSGOE92
if Y>0
GOTO @Y
GOTO A34
+9 IF X="@"!(X?1."?")
if X="@"
WRITE $CHAR(7)," (Required)"
if X="@"
SET X="?"
DO ENHLP^PSGOEM(55.06,34)
+10 IF X=+X
IF (X>0)
IF (X'>2000000)
if '$$ENDL^PSGDL(PSGSCH,X)
GOTO A34
KILL PSGDLS
SET PSGDL=X
WRITE " ...dose limit..."
DO ENE^PSGDL
+11 KILL %DT
SET %DT="ERTX"
SET %DT(0)=PSGSD
DO ^%DT
KILL %DT
if Y'>0
GOTO A34
SET (PSGFDX,PSGFD)=+Y
SET PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
W34 ;Compare to Start Date
+1 NEW Z,MSG
+2 DO DOSE^PSGOE91
IF $GET(Z)]""
IF Z>$SELECT($GET(PSGFD):PSGFD,1:$GET(PSGNEFD))
Begin DoDot:1
+3 SET MSG(1)="There is no administration time that falls between the Start Date/Time"
+4 SET MSG(2)="and the Stop Date/Time."
+5 DO EN^DDIOL(.MSG)
End DoDot:1
GOTO A34
+6 IF PSGFD<PSGDT
WRITE $CHAR(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
SET MSG=1
+7 QUIT
A34DONE ; clean up Active UD Stop Date vars
+1 KILL MSG
+2 QUIT
A25NV ; Stop Date Non-Verified
+1 KILL PSGFDX
+2 WRITE !,"STOP DATE/TIME: "_$SELECT($PIECE(PSGFDN,"^")]"":$PIECE(PSGFDN,"^")_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
if '$TEST
WRITE $CHAR(7)
SET PSGOEE=0
GOTO A25DONE
+3 ;W " "_$P(PSGFDN,"^")
IF X=""
IF PSGFD
SET X=$PIECE(PSGFDN,"^")
+4 IF $EXTRACT(X)="^"
DO ENFF^PSGOE82
if Y>0
GOTO @Y
GOTO A25NV
+5 IF X="@"!(X?1."?")
if X="@"
WRITE $CHAR(7)," (Required)"
if X="@"
SET X="?"
DO ENHLP^PSGOEM(53.1,25)
+6 IF X=+X
IF (X>0)
IF (X'>2000000)
if '$$ENDL^PSGDL(PSGSCH,X)
GOTO A25NV
KILL PSGDLS
SET PSGDL=X
WRITE " ...dose limit..."
DO ENE^PSGDL
+7 KILL %DT
SET %DT="ERTX"
SET %DT(0)=PSGSD
DO ^%DT
KILL %DT
if Y'>0
GOTO A25NV
SET (PSGFDX,PSGFD,PSGNEFD)=+Y
SET PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
W25 ; Loop Stop Date NV
+1 NEW Z,MSG
+2 DO DOSE^PSGOE81
IF $GET(Z)]""
IF Z>PSGNEFD
Begin DoDot:1
+3 SET MSG(1)="There is no administration time that falls between the Start Date/Time"
+4 SET MSG(2)="and the Stop Date/Time."
+5 DO EN^DDIOL(.MSG)
End DoDot:1
GOTO A25NV
+6 IF PSGFD<PSGDT
WRITE $CHAR(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
GOTO A25NV
+7 QUIT
A25DONE ; NV Stop Date Done
+1 DO EFDNV^PSJUTL
+2 KILL MSG
+3 QUIT
A25V(DFN,ON) ; Stop Date Active IV
+1 NEW X,TMPY,DIR
A25V2 ; IV Stop Date Continued
+1 IF P("IVRM")]""
IF $SELECT(P(3)<P(2):1,$GET(PSIVAC)["E":0,1:1)
SET PSIVSITE=$GET(^PS(59.5,+P("IVRM"),1))
SET $PIECE(PSIVSITE,"^",20,21)=$GET(^PS(59.5,+P("IVRM"),5))
DO ENSTOP^PSIVCAL
+2 IF $GET(ON)["V"!($GET(ON)["U")
IF $$COMPLEX^PSJOE(DFN,ON)
Begin DoDot:1
+3 if $GET(PSJBKDR)
QUIT
WRITE !!?5,"This is a Complex Order. Stop Date may not be edited at this point."
DO PAUSE^VALM1
End DoDot:1
QUIT
+4 SET Y=P(3)
XECUTE ^DD("DD")
WRITE !,"STOP DATE/TIME: "_$SELECT(Y]"":Y_"// ",1:"")
READ X:DTIME
if '$TEST
SET X=U
if X=U
SET DONE=1
if X=""&P(2)
QUIT
IF $EXTRACT(X)=U!(X=""&P(2))
QUIT
+5 IF X="@"!(X["?")
WRITE $CHAR(7)," (Required)"
SET F1=53.1
SET F2=25
SET X="?"
DO ENHLP^PSIVORC1
GOTO A25V2
+6 KILL %DT
if X=""
SET X=$GET(Y)
if X=""
SET X=P(3)
SET %DT="TE"
if X'=+X
DO ^%DT
+7 IF X=+X
IF X>0
IF X'>2000000
if '$$ENDL^PSGDL(P(9),X)
GOTO A25V2
DO ENDL^PSIVSP
+8 SET TMPY=Y
IF TMPY["^"
SET PSJQMSG=0
QUIT
+9 IF $EXTRACT(TMPY)="?"
KILL DIR,X,Y
DO ENHLP^PSGOEM(55.06,10)
SET PSJQMSG=1
GOTO A25V2
+10 IF TMPY'["."
WRITE $CHAR(7),!?5," Time is REQUIRED. Re-enter Start Date. "
SET PSJQMSG=1
GOTO A25V2
+11 DO DOSE^PSIVEDT1
+12 IF $GET(X)=""
SET X=Y
+13 IF $GET(X)=""
SET X=P(3)
+14 IF $GET(Z)]""
IF Z>X
Begin DoDot:1
+15 WRITE !,"There is no administration time that falls between the Start Date/Time"
+16 WRITE !,"and Stop Date/Time.",!
End DoDot:1
GOTO A25V2
+17 SET X=Y
if Y<1!Y'["."
SET X=""
if Y'>0
GOTO A25V2
SET P(3)=+Y
SET PSGFDX=1
+18 QUIT
