PSGVBWP ;BIR/CML3-INPATIENT MEDICATIONS PROFILE FROM NON-VERIFIED/PENDING ;25 SEP 97 / 7:42 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
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) DONE S:$D(PSJEXTP) PSJSEL("SELECT")="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
K PSJACNWP,PSJACOK,PSJDEV,PSJDBL,PSJION,PSJOL,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
;*
;* K PSGLI,PSGWD,PSJAT,PSJPNRB,PSJPWDO,PSJSTOP,PSJTEAM
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 ;
K PSJSEL S PSJSEL("SELECT")="P" F X=0:0 S X=$O(^TMP("PSJSELECT",$J,X)) Q:'X D
.S Y=$G(^TMP("PSJSELECT",$J,X)) I $P(Y,U)=""!($P(Y,U,2)="") Q
.S PSJSEL("P",$P(Y,U),$P(Y,U,2))=""
S PSJPRP="P",PSJOS=$P(PSJSYSP0,"^",11)
K ZTSAVE S PSGTIR="ENQ^PSGVBWP",ZTDESC="INPATIENT PATIENT PROFILE" F X="DFN","PSJSEL(","PSJOL","PSJOS","PSJPRA","PSJPRP","PSGPTMP","PPAGE","PSJEXTP","PSJHDATE" S ZTSAVE(X)=""
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
;
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
;.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)=""
;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",(PSGORD["U") 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 S (PSGP,DFN)=+ORVP,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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGVBWP 5144 printed Sep 23, 2025@19:39:33 Page 2
PSGVBWP ;BIR/CML3-INPATIENT MEDICATIONS PROFILE FROM NON-VERIFIED/PENDING ;25 SEP 97 / 7:42 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 NEW PFLG,PSJNEW,PSGPTMP,PPAGE,QFLG
SET PSJNEW=1
+3 NEW PSGLI,PSGWD,PSJAT,PSJPNRB,PSJPWDO,PSJSTOP,PSJTEAM
+4 ;
EN ;
+1 if $DATA(XQUIT)
GOTO DONE
+2 ;D @$S('$D(PSJEXTP):"^PSIVXU",1:"ENCV^PSGSETU")
+3 ;G:$D(XQUIT) DONE S PSGPTMP=0,PPAGE=1 K PSJSEL D @$S($D(PSJEXTP):"P^PSJPDIR",1:"GWP^PSJPDIR") G:$G(PSJSTOP) DONE S:$D(PSJEXTP) PSJSEL("SELECT")="P"
+4 DO ENL^PSJO3
if "^N"[PSJOL
GOTO EN
DO GO
+5 ;
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
+4 KILL PSJACNWP,PSJACOK,PSJDEV,PSJDBL,PSJION,PSJOL,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 ;*
+7 ;* K PSGLI,PSGWD,PSJAT,PSJPNRB,PSJPWDO,PSJSTOP,PSJTEAM
+8 QUIT
+9 ;
GO ;
+1 ;S PSJPRP="P",PSJPRA="" G:PSJSEL("SELECT")'="P" DEV
+2 ;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
+3 ;I "EB"[PSJPRP F R !!,"Show SHORT, LONG, or NO activity log? NO// ",AT:DTIME D ALC^PSGVW0 I Q S PSJPRA=AT Q
+4 ;G:PSJPRA="^" EN
DEV ;
+1 KILL PSJSEL
SET PSJSEL("SELECT")="P"
FOR X=0:0
SET X=$ORDER(^TMP("PSJSELECT",$JOB,X))
if 'X
QUIT
Begin DoDot:1
+2 SET Y=$GET(^TMP("PSJSELECT",$JOB,X))
IF $PIECE(Y,U)=""!($PIECE(Y,U,2)="")
QUIT
+3 SET PSJSEL("P",$PIECE(Y,U),$PIECE(Y,U,2))=""
End DoDot:1
+4 SET PSJPRP="P"
SET PSJOS=$PIECE(PSJSYSP0,"^",11)
+5 KILL ZTSAVE
SET PSGTIR="ENQ^PSGVBWP"
SET ZTDESC="INPATIENT PATIENT PROFILE"
FOR X="DFN","PSJSEL(","PSJOL","PSJOS","PSJPRA","PSJPRP","PSGPTMP","PPAGE","PSJEXTP","PSJHDATE"
SET ZTSAVE(X)=""
+6 DO ENDEV^PSGTI
if POP
QUIT
if '$DATA(IO("Q"))
DO ENQ
+7 QUIT
+8 ;
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
+7 ;
PG ;
+1 ;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)="^"
+2 QUIT
+3 ;
PW ;
+1 ;K ^TMP("PSJAT",$J) F DFN=0:0 S (DFN,PSGP)=$O(^DPT("CN",PSJPRWN,DFN)) Q:'DFN D
+2 ;.S RB=$P($G(^DPT(DFN,.101)),U),PPN=$P($G(^(0)),U),X=$S(PSJSEL("RBP")="R":RB,1:PPN),AT=""
+3 ;.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)))
+4 ;.F Y="AT","RB","X" S:@Y="" @Y="ZZ"
+5 ;.S ^TMP("PSJAT",$J,AT,X,DFN)=""
+6 ;K PSJDBL S PSJAT="" F S PSJAT=$O(^TMP("PSJAT",$J,PSJAT)) Q:PSJAT=""!$G(PSJDBL) D
+7 ;.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
+8 QUIT
+9 ;
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
+8 ;
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 (PSGORD["U")
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 SET (PSGP,DFN)=+ORVP
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 SET PSJNKF=1
DO READ^PSJUTL
GOTO DONE
