PSJMPRT ;BIR/MV-PRINT DRIVE FOR MDWS ;13 FEB 96 / 10:06 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
;Loop thru TMP global to print report
;
INIT ;
Q:'$D(^TMP($J)) U IO
NEW DRG,ND,PID,PID1,PPN,PPN1,PPNO,PRB,PRB1,PRBO,QST,TM,TM1,TMO,UD0,UD2,XNAME
S PSJHL1="MEDICATIONS DUE WORKSHEET For: "
S PSJHL2="Report from: "_$$ENDTC^PSGMI(PSGPLS)_" to: "_$$ENDTC^PSGMI(PSGPLF)_" "_"Report Date: "_$E($$ENDTC^PSGMI(DT),1,8)
S XNAME="" S:PSGMTYPE[1 XNAME="ALL MEDS"
S:PSGMTYPE[2 XNAME="NON-IV MEDs"
I PSGMTYPE[3 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"IVPB"
I PSGMTYPE[4 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"LVPs"
I PSGMTYPE[5 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"TPNs"
I PSGMTYPE[6 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"CHEMO (IV)"
S PSJHL3="Continuous/One time Orders for: "_XNAME
S PSJHL62="* Projected admin. times based on order's volume, flow rate, and start time."
S (PSGPG,PSJNEED,PSJLN,PSJADTO,PSJATMEO)=0,(PPNO,PRBO,TMO)=""
S (PPN,QST,DRG,TM,PSJPRB)="",PSJTOTLN=$S($E(IOST)="C":23,1:62)
D @PSGSS
I PSGPG,$G(PSJASTR) D
. S X=$Y F X=X:1:PSJTOTLN W !
. W !,PSJHL62 S PSJASTR=0
Q
;
P ;***Selected by Patients.
F PSJADT=0:0 S PSJADT=$O(^TMP($J,PSJADT)) Q:'PSJADT F S PPN=$O(^TMP($J,PSJADT,PPN)) Q:PPN="" D
. S PSJHL1=$P(PSJHL1,":")_": "_$P(PPN,U)
. F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,PPN,PSJATME)) Q:'PSJATME F S QST=$O(^TMP($J,PSJADT,PPN,PSJATME,QST)) Q:QST="" D
. . F S DRG=$O(^TMP($J,PSJADT,PPN,PSJATME,QST,DRG)) Q:DRG="" D:'$G(PSJSTOP) PRT
Q
;
G ;***Selected by Ward Group.
S PSJHL1=PSJHL1_PSGWGNM
;
W ;***Selected by Ward.
S:PSGSS="W" PSJHL1=PSJHL1_PSGWN
F PSJADT=0:0 S PSJADT=$O(^TMP($J,PSJADT)) Q:'PSJADT F S TM=$O(^TMP($J,PSJADT,TM)) Q:TM="" D @("W"_PSGRBADM)
Q
;
WA ;*** Selected by Ward and sort by Admin. time.
F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,TM,PSJATME)) Q:'PSJATME F S PSJPRB=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB)) Q:PSJPRB="" D
. F S PPN=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN)) Q:PPN="" F S QST=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN,QST)) Q:QST="" D
. .F S DRG=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN,QST,DRG)) Q:DRG="" D:'$G(PSJSTOP) PRT
Q
;
WP ;*** Selected by Ward and sort by Patients.
F S PPN=$O(^TMP($J,PSJADT,TM,PPN)) Q:PPN="" F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,TM,PPN,PSJATME)) Q:'PSJATME D
. F S QST=$O(^TMP($J,PSJADT,TM,PPN,PSJATME,QST)) Q:QST="" F S DRG=$O(^TMP($J,PSJADT,TM,PPN,PSJATME,QST,DRG)) Q:DRG="" D
. . D:'$G(PSJSTOP) PRT
Q
;
WR ;*** Selected by Ward and sort by Room-Bed.
F S PSJPRB=$O(^TMP($J,PSJADT,TM,PSJPRB)) Q:PSJPRB="" F S PPN=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN)) Q:PPN="" D
. F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME)) Q:'PSJATME F S QST=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME,QST)) Q:QST="" D
. . F S DRG=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME,QST,DRG)) Q:DRG="" D:'$G(PSJSTOP) PRT
Q
;
PRT ;
S ND=^(DRG),PSGP=+ND,ON=$P(ND,U,2),PID=$P(ND,U,3),PSGWN=$S(PSGSS="W":"",1:$P(ND,U,4)),PRB=$P(ND,U,5)
I QST["V" D PRT^PSJMIV Q
S ND=^TMP($J,QST,PSGP,ON),PSJDOS=$P(ND,U),PSJMR=$P(ND,U,2),PSJSCHE=$P(ND,U,3),PSJHOLD=$S($P(ND,U,4):1,1:0)
S PSGLOD=$E($$ENDTC^PSGMI($P(ND,U,5)),1,5)
I QST'["Z" S X=$$ENDTC^PSGMI($P(ND,U,6)),PSGLSD=$E(X,1,5)_$E(X,9,15),PSGLFD=$$ENDTC^PSGMI($P(ND,U,7))
S PSJONETM=$S(QST="O":1,1:0),PSJONCAL=$S(QST="OA":1,1:0)
S PSJSI=$$ENSET^PSGSICHK(^TMP($J,QST,PSGP,ON,1))
NEW MARX
D DRGDISP^PSJLMUT1(PSGP,+ON_$S(QST["Z":"P",1:"U"),40,0,.MARX,1)
S PSJNEED=$S($D(MARX(2)):2,1:1)
S X=$L(PSJSI)/41,X=$P(X,".")+($P(X,".",2)>0)
S PSJNEED=PSJNEED+X+5+PSJHOLD+PSJONETM+PSJONCAL
D ^PSJMPRTU,PRT^PSJMPRTU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJMPRT 3690 printed Sep 23, 2025@19:43:54 Page 2
PSJMPRT ;BIR/MV-PRINT DRIVE FOR MDWS ;13 FEB 96 / 10:06 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 ;Loop thru TMP global to print report
+3 ;
INIT ;
+1 if '$DATA(^TMP($JOB))
QUIT
USE IO
+2 NEW DRG,ND,PID,PID1,PPN,PPN1,PPNO,PRB,PRB1,PRBO,QST,TM,TM1,TMO,UD0,UD2,XNAME
+3 SET PSJHL1="MEDICATIONS DUE WORKSHEET For: "
+4 SET PSJHL2="Report from: "_$$ENDTC^PSGMI(PSGPLS)_" to: "_$$ENDTC^PSGMI(PSGPLF)_" "_"Report Date: "_$EXTRACT($$ENDTC^PSGMI(DT),1,8)
+5 SET XNAME=""
if PSGMTYPE[1
SET XNAME="ALL MEDS"
+6 if PSGMTYPE[2
SET XNAME="NON-IV MEDs"
+7 IF PSGMTYPE[3
if XNAME]""
SET XNAME=XNAME_", "
SET XNAME=XNAME_"IVPB"
+8 IF PSGMTYPE[4
if XNAME]""
SET XNAME=XNAME_", "
SET XNAME=XNAME_"LVPs"
+9 IF PSGMTYPE[5
if XNAME]""
SET XNAME=XNAME_", "
SET XNAME=XNAME_"TPNs"
+10 IF PSGMTYPE[6
if XNAME]""
SET XNAME=XNAME_", "
SET XNAME=XNAME_"CHEMO (IV)"
+11 SET PSJHL3="Continuous/One time Orders for: "_XNAME
+12 SET PSJHL62="* Projected admin. times based on order's volume, flow rate, and start time."
+13 SET (PSGPG,PSJNEED,PSJLN,PSJADTO,PSJATMEO)=0
SET (PPNO,PRBO,TMO)=""
+14 SET (PPN,QST,DRG,TM,PSJPRB)=""
SET PSJTOTLN=$SELECT($EXTRACT(IOST)="C":23,1:62)
+15 DO @PSGSS
+16 IF PSGPG
IF $GET(PSJASTR)
Begin DoDot:1
+17 SET X=$Y
FOR X=X:1:PSJTOTLN
WRITE !
+18 WRITE !,PSJHL62
SET PSJASTR=0
End DoDot:1
+19 QUIT
+20 ;
P ;***Selected by Patients.
+1 FOR PSJADT=0:0
SET PSJADT=$ORDER(^TMP($JOB,PSJADT))
if 'PSJADT
QUIT
FOR
SET PPN=$ORDER(^TMP($JOB,PSJADT,PPN))
if PPN=""
QUIT
Begin DoDot:1
+2 SET PSJHL1=$PIECE(PSJHL1,":")_": "_$PIECE(PPN,U)
+3 FOR PSJATME=0:0
SET PSJATME=$ORDER(^TMP($JOB,PSJADT,PPN,PSJATME))
if 'PSJATME
QUIT
FOR
SET QST=$ORDER(^TMP($JOB,PSJADT,PPN,PSJATME,QST))
if QST=""
QUIT
Begin DoDot:2
+4 FOR
SET DRG=$ORDER(^TMP($JOB,PSJADT,PPN,PSJATME,QST,DRG))
if DRG=""
QUIT
if '$GET(PSJSTOP)
DO PRT
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
G ;***Selected by Ward Group.
+1 SET PSJHL1=PSJHL1_PSGWGNM
+2 ;
W ;***Selected by Ward.
+1 if PSGSS="W"
SET PSJHL1=PSJHL1_PSGWN
+2 FOR PSJADT=0:0
SET PSJADT=$ORDER(^TMP($JOB,PSJADT))
if 'PSJADT
QUIT
FOR
SET TM=$ORDER(^TMP($JOB,PSJADT,TM))
if TM=""
QUIT
DO @("W"_PSGRBADM)
+3 QUIT
+4 ;
WA ;*** Selected by Ward and sort by Admin. time.
+1 FOR PSJATME=0:0
SET PSJATME=$ORDER(^TMP($JOB,PSJADT,TM,PSJATME))
if 'PSJATME
QUIT
FOR
SET PSJPRB=$ORDER(^TMP($JOB,PSJADT,TM,PSJATME,PSJPRB))
if PSJPRB=""
QUIT
Begin DoDot:1
+2 FOR
SET PPN=$ORDER(^TMP($JOB,PSJADT,TM,PSJATME,PSJPRB,PPN))
if PPN=""
QUIT
FOR
SET QST=$ORDER(^TMP($JOB,PSJADT,TM,PSJATME,PSJPRB,PPN,QST))
if QST=""
QUIT
Begin DoDot:2
+3 FOR
SET DRG=$ORDER(^TMP($JOB,PSJADT,TM,PSJATME,PSJPRB,PPN,QST,DRG))
if DRG=""
QUIT
if '$GET(PSJSTOP)
DO PRT
End DoDot:2
End DoDot:1
+4 QUIT
+5 ;
WP ;*** Selected by Ward and sort by Patients.
+1 FOR
SET PPN=$ORDER(^TMP($JOB,PSJADT,TM,PPN))
if PPN=""
QUIT
FOR PSJATME=0:0
SET PSJATME=$ORDER(^TMP($JOB,PSJADT,TM,PPN,PSJATME))
if 'PSJATME
QUIT
Begin DoDot:1
+2 FOR
SET QST=$ORDER(^TMP($JOB,PSJADT,TM,PPN,PSJATME,QST))
if QST=""
QUIT
FOR
SET DRG=$ORDER(^TMP($JOB,PSJADT,TM,PPN,PSJATME,QST,DRG))
if DRG=""
QUIT
Begin DoDot:2
+3 if '$GET(PSJSTOP)
DO PRT
End DoDot:2
End DoDot:1
+4 QUIT
+5 ;
WR ;*** Selected by Ward and sort by Room-Bed.
+1 FOR
SET PSJPRB=$ORDER(^TMP($JOB,PSJADT,TM,PSJPRB))
if PSJPRB=""
QUIT
FOR
SET PPN=$ORDER(^TMP($JOB,PSJADT,TM,PSJPRB,PPN))
if PPN=""
QUIT
Begin DoDot:1
+2 FOR PSJATME=0:0
SET PSJATME=$ORDER(^TMP($JOB,PSJADT,TM,PSJPRB,PPN,PSJATME))
if 'PSJATME
QUIT
FOR
SET QST=$ORDER(^TMP($JOB,PSJADT,TM,PSJPRB,PPN,PSJATME,QST))
if QST=""
QUIT
Begin DoDot:2
+3 FOR
SET DRG=$ORDER(^TMP($JOB,PSJADT,TM,PSJPRB,PPN,PSJATME,QST,DRG))
if DRG=""
QUIT
if '$GET(PSJSTOP)
DO PRT
End DoDot:2
End DoDot:1
+4 QUIT
+5 ;
PRT ;
+1 SET ND=^(DRG)
SET PSGP=+ND
SET ON=$PIECE(ND,U,2)
SET PID=$PIECE(ND,U,3)
SET PSGWN=$SELECT(PSGSS="W":"",1:$PIECE(ND,U,4))
SET PRB=$PIECE(ND,U,5)
+2 IF QST["V"
DO PRT^PSJMIV
QUIT
+3 SET ND=^TMP($JOB,QST,PSGP,ON)
SET PSJDOS=$PIECE(ND,U)
SET PSJMR=$PIECE(ND,U,2)
SET PSJSCHE=$PIECE(ND,U,3)
SET PSJHOLD=$SELECT($PIECE(ND,U,4):1,1:0)
+4 SET PSGLOD=$EXTRACT($$ENDTC^PSGMI($PIECE(ND,U,5)),1,5)
+5 IF QST'["Z"
SET X=$$ENDTC^PSGMI($PIECE(ND,U,6))
SET PSGLSD=$EXTRACT(X,1,5)_$EXTRACT(X,9,15)
SET PSGLFD=$$ENDTC^PSGMI($PIECE(ND,U,7))
+6 SET PSJONETM=$SELECT(QST="O":1,1:0)
SET PSJONCAL=$SELECT(QST="OA":1,1:0)
+7 SET PSJSI=$$ENSET^PSGSICHK(^TMP($JOB,QST,PSGP,ON,1))
+8 NEW MARX
+9 DO DRGDISP^PSJLMUT1(PSGP,+ON_$SELECT(QST["Z":"P",1:"U"),40,0,.MARX,1)
+10 SET PSJNEED=$SELECT($DATA(MARX(2)):2,1:1)
+11 SET X=$LENGTH(PSJSI)/41
SET X=$PIECE(X,".")+($PIECE(X,".",2)>0)
+12 SET PSJNEED=PSJNEED+X+5+PSJHOLD+PSJONETM+PSJONCAL
+13 DO ^PSJMPRTU
DO PRT^PSJMPRTU
+14 QUIT
