PSGEUDP ;BIR/MV-PRINT EXTRA UNITS DISP. ;04 JAN 95 / 12:27 PM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
START ;
;*** The drug name will be truncated to 33 chars when print
;*** by Ward/WardGroup
I '$D(^TMP($J)) W !!,"NO DATA FOUND ON EXTRA UNITS DISPENSED" G EXIT
U IO
NEW MSG1,MSG2,DRGO,PPNO,TMO,PNAME
S (PSGPG,PSJSTOP)=0
S MSG1="TOTAL FOR ",$P(MSG2,".",80)="."
D @($S(PSGSS="P":"P",1:"W"))
EXIT D EXITDEV^PSJMUTL
K PSGTOTD,PSGTOTM,PSGTOTU,PSGTOTW,PSGWNO,PSGPG
Q
;
P ;*** Print by patient.
S (PPNO,DRGO)=""
S (PPN,DRG)="" F S PPN=$O(^TMP($J,PPN)) Q:(PPN=""!$G(PSJSTOP)) S PNAME=$P($G(^DPT($P(PPN,"^",2),0)),"^") F S DRG=$O(^TMP($J,PPN,DRG)) Q:(DRG=""!$G(PSJSTOP)) D
. F PSGDT=0:0 S PSGDT=$O(^TMP($J,PPN,DRG,PSGDT)) Q:('PSGDT!$G(PSJSTOP)) D PRTPT
Q:$G(PSJSTOP)
D:DRGO]"" TOT(PSGTOTD," ",46),TOT(PSGTOTU,MSG1_$P($G(^DPT($P(PPNO,"^",2),0)),"^"),46)
Q
;
PRTPT ;*** Print Extra Dispensed Drug sort by patient.
S ND=^TMP($J,PPN,DRG,PSGDT)
I PPN'=PPNO D:DRGO]"" TOT(PSGTOTD," ",46) D:PPNO]"" TOT(PSGTOTU,MSG1_$P($G(^DPT($P(PPNO,"^",2),0)),"^"),46) D PHDR S PSGTOTU=0,PPNO=PPN,DRGO=""
I DRG'=DRGO D:DRGO]"" TOT(PSGTOTD," ",46) W !,DRG S DRGO=DRG,PSGTOTD=0
E W !
W ?46,$J(+ND,5),?53,$$ENDTC^PSGMI(PSGDT),?69,$E($P(^VA(200,+$P(ND,U,2),0),U,2),1,4)
D:($Y+5)>IOSL PHDR
S PSGTOTD=PSGTOTD+(+ND),PSGTOTU=PSGTOTU+(+ND)
Q
;
TOT(TOT,NAME,X) ;*** Print the total line for drug,patient,team,ward...
W !?2,NAME,$E(MSG2,1,X-2-$L(NAME)),?X,$J(TOT,5),!
Q
;
PHDR ;*** Print the header when sort by patient.
D HDR Q:$G(PSJSTOP)
W !!,PNAME,?39,"Room_Bed: "_$P(ND,U,4),!,$P(ND,U,3),?39," Ward: "_$P(ND,U,5),!
W !!,"DRUG NAME",?47,"UNIT",?53,"DATE",?69,"DISP."
W !?53,"DISPENSED",?69,"BY",!
Q
HDR ;*** Print the report main header.
Q:$$PRTCHK^PSJMUTL(PSGPG)
S PSGPG=PSGPG+1 W:$Y @IOF
W !?30,"EXTRA UNITS DISPENSED REPORT",?68,"PAGE: ",PSGPG
W !?17,"REPORT FROM: ",$$ENDTC^PSGMI(PSGSDT)," TO: ",$$ENDTC^PSGMI(PSGEDT),!
Q
W ;***Print by ward/ward group.
S (DRGO,PSGWN,PSGWNO,TMO)="",(PSGTOTD,PSGTOTM,PSGTOTU,PSGTOTW)=0
F S PSGWN=$O(^TMP($J,PSGWN)) Q:(PSGWN=""!$G(PSJSTOP)) S TM="" F S TM=$O(^TMP($J,PSGWN,TM)) Q:(TM=""!$G(PSJSTOP)) D
. S DRG="" F S DRG=$O(^TMP($J,PSGWN,TM,DRG)) Q:(DRG=""!$G(PSJSTOP)) S PPN="" F S PPN=$O(^TMP($J,PSGWN,TM,DRG,PPN)) Q:(PPN=""!$G(PSJSTOP)) S PNAME=$P($G(^DPT($P(PPN,"^",2),0)),"^") D
. . F PSGDT=0:0 S PSGDT=$O(^TMP($J,PSGWN,TM,DRG,PPN,PSGDT)) Q:('PSGDT!$G(PSJSTOP)) D PRTW
Q:$G(PSJSTOP)
D:PSGTOTD TOT(PSGTOTD," ",53) D:TMO]""&(PSGTOTM&($G(PSGTM)!$G(PSGTMALL))) TOT(PSGTOTM,MSG1_TMO,53) D:PSGTOTW TOT(PSGTOTW,MSG1_PSGWNO,53) D:$G(PSGWGNM)]"" TOT(PSGTOTU,MSG1_PSGWGNM,53)
Q
;
PRTW ;*** Print output for ward/ward group
S ND=^TMP($J,PSGWN,TM,DRG,PPN,PSGDT)
D:'PSGPG WHDR
I PSGWN'=PSGWNO D
. D:DRGO]"" TOT(PSGTOTD," ",53) D:TMO]""&($G(PSGTM)!$G(PSGTMALL)) TOT(PSGTOTM,MSG1_TMO,53) D:PSGWNO]"" TOT(PSGTOTW,MSG1_PSGWNO,53)
. W !,"WARD: ",PSGWN W:$G(PSGTM)!$G(PSGTMALL) !,"TEAM: ",TM
. S DRGO="",TMO=TM,PSGWNO=PSGWN,(PSGTOTD,PSGTOTM,PSGTOTW)=0
I ($G(PSGTM)!$G(PSGTMALL)),TM'=TMO D:DRGO]"" TOT(PSGTOTD," ",53) D:TMO]"" TOT(PSGTOTM,MSG1_TMO,53) W !,"TEAM: ",TM S TMO=TM,DRGO="",(PSGTOTD,PSGTOTM)=0
I DRG'=DRGO D:DRGO]"" TOT(PSGTOTD," ",53) W !!,$E(DRG,1,31) S DRGO=DRG,PSGTOTD=0
E W !
W ?33,$E(PNAME,1,13)_"("_$P(ND,U,3)_")",?53,$J(+ND,5),?59,$$ENDTC^PSGMI(PSGDT),?75,$E($P(^VA(200,+$P(ND,U,2),0),U,2),1,4)
D:($Y+5)>IOSL WHDR
S PSGTOTD=PSGTOTD+(+ND),PSGTOTU=PSGTOTU+(+ND),PSGTOTM=PSGTOTM+(+ND),PSGTOTW=PSGTOTW+(+ND)
Q
;
WHDR ;***Print ward/ward group header
D HDR
Q:$G(PSJSTOP)
W !!,"DRUG NAME",?33,"PATIENT",?54,"UNIT",?59,"DATE",?75,"DISP.",!,?59,"DISPENSED",?75,"BY",!
F X=1:1:80 W "="
W !
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGEUDP 3776 printed Sep 23, 2025@19:37:19 Page 2
PSGEUDP ;BIR/MV-PRINT EXTRA UNITS DISP. ;04 JAN 95 / 12:27 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
START ;
+1 ;*** The drug name will be truncated to 33 chars when print
+2 ;*** by Ward/WardGroup
+3 IF '$DATA(^TMP($JOB))
WRITE !!,"NO DATA FOUND ON EXTRA UNITS DISPENSED"
GOTO EXIT
+4 USE IO
+5 NEW MSG1,MSG2,DRGO,PPNO,TMO,PNAME
+6 SET (PSGPG,PSJSTOP)=0
+7 SET MSG1="TOTAL FOR "
SET $PIECE(MSG2,".",80)="."
+8 DO @($SELECT(PSGSS="P":"P",1:"W"))
EXIT DO EXITDEV^PSJMUTL
+1 KILL PSGTOTD,PSGTOTM,PSGTOTU,PSGTOTW,PSGWNO,PSGPG
+2 QUIT
+3 ;
P ;*** Print by patient.
+1 SET (PPNO,DRGO)=""
+2 SET (PPN,DRG)=""
FOR
SET PPN=$ORDER(^TMP($JOB,PPN))
if (PPN=""!$GET(PSJSTOP))
QUIT
SET PNAME=$PIECE($GET(^DPT($PIECE(PPN,"^",2),0)),"^")
FOR
SET DRG=$ORDER(^TMP($JOB,PPN,DRG))
if (DRG=""!$GET(PSJSTOP))
QUIT
Begin DoDot:1
+3 FOR PSGDT=0:0
SET PSGDT=$ORDER(^TMP($JOB,PPN,DRG,PSGDT))
if ('PSGDT!$GET(PSJSTOP))
QUIT
DO PRTPT
End DoDot:1
+4 if $GET(PSJSTOP)
QUIT
+5 if DRGO]""
DO TOT(PSGTOTD," ",46)
DO TOT(PSGTOTU,MSG1_$PIECE($GET(^DPT($PIECE(PPNO,"^",2),0)),"^"),46)
+6 QUIT
+7 ;
PRTPT ;*** Print Extra Dispensed Drug sort by patient.
+1 SET ND=^TMP($JOB,PPN,DRG,PSGDT)
+2 IF PPN'=PPNO
if DRGO]""
DO TOT(PSGTOTD," ",46)
if PPNO]""
DO TOT(PSGTOTU,MSG1_$PIECE($GET(^DPT($PIECE(PPNO,"^",2),0)),"^"),46)
DO PHDR
SET PSGTOTU=0
SET PPNO=PPN
SET DRGO=""
+3 IF DRG'=DRGO
if DRGO]""
DO TOT(PSGTOTD," ",46)
WRITE !,DRG
SET DRGO=DRG
SET PSGTOTD=0
+4 IF '$TEST
WRITE !
+5 WRITE ?46,$JUSTIFY(+ND,5),?53,$$ENDTC^PSGMI(PSGDT),?69,$EXTRACT($PIECE(^VA(200,+$PIECE(ND,U,2),0),U,2),1,4)
+6 if ($Y+5)>IOSL
DO PHDR
+7 SET PSGTOTD=PSGTOTD+(+ND)
SET PSGTOTU=PSGTOTU+(+ND)
+8 QUIT
+9 ;
TOT(TOT,NAME,X) ;*** Print the total line for drug,patient,team,ward...
+1 WRITE !?2,NAME,$EXTRACT(MSG2,1,X-2-$LENGTH(NAME)),?X,$JUSTIFY(TOT,5),!
+2 QUIT
+3 ;
PHDR ;*** Print the header when sort by patient.
+1 DO HDR
if $GET(PSJSTOP)
QUIT
+2 WRITE !!,PNAME,?39,"Room_Bed: "_$PIECE(ND,U,4),!,$PIECE(ND,U,3),?39," Ward: "_$PIECE(ND,U,5),!
+3 WRITE !!,"DRUG NAME",?47,"UNIT",?53,"DATE",?69,"DISP."
+4 WRITE !?53,"DISPENSED",?69,"BY",!
+5 QUIT
HDR ;*** Print the report main header.
+1 if $$PRTCHK^PSJMUTL(PSGPG)
QUIT
+2 SET PSGPG=PSGPG+1
if $Y
WRITE @IOF
+3 WRITE !?30,"EXTRA UNITS DISPENSED REPORT",?68,"PAGE: ",PSGPG
+4 WRITE !?17,"REPORT FROM: ",$$ENDTC^PSGMI(PSGSDT)," TO: ",$$ENDTC^PSGMI(PSGEDT),!
+5 QUIT
W ;***Print by ward/ward group.
+1 SET (DRGO,PSGWN,PSGWNO,TMO)=""
SET (PSGTOTD,PSGTOTM,PSGTOTU,PSGTOTW)=0
+2 FOR
SET PSGWN=$ORDER(^TMP($JOB,PSGWN))
if (PSGWN=""!$GET(PSJSTOP))
QUIT
SET TM=""
FOR
SET TM=$ORDER(^TMP($JOB,PSGWN,TM))
if (TM=""!$GET(PSJSTOP))
QUIT
Begin DoDot:1
+3 SET DRG=""
FOR
SET DRG=$ORDER(^TMP($JOB,PSGWN,TM,DRG))
if (DRG=""!$GET(PSJSTOP))
QUIT
SET PPN=""
FOR
SET PPN=$ORDER(^TMP($JOB,PSGWN,TM,DRG,PPN))
if (PPN=""!$GET(PSJSTOP))
QUIT
SET PNAME=$PIECE($GET(^DPT($PIECE(PPN,"^",2),0)),"^")
Begin DoDot:2
+4 FOR PSGDT=0:0
SET PSGDT=$ORDER(^TMP($JOB,PSGWN,TM,DRG,PPN,PSGDT))
if ('PSGDT!$GET(PSJSTOP))
QUIT
DO PRTW
End DoDot:2
End DoDot:1
+5 if $GET(PSJSTOP)
QUIT
+6 if PSGTOTD
DO TOT(PSGTOTD," ",53)
if TMO]""&(PSGTOTM&($GET(PSGTM)!$GET(PSGTMALL)))
DO TOT(PSGTOTM,MSG1_TMO,53)
if PSGTOTW
DO TOT(PSGTOTW,MSG1_PSGWNO,53)
if $GET(PSGWGNM)]""
DO TOT(PSGTOTU,MSG1_PSGWGNM,53)
+7 QUIT
+8 ;
PRTW ;*** Print output for ward/ward group
+1 SET ND=^TMP($JOB,PSGWN,TM,DRG,PPN,PSGDT)
+2 if 'PSGPG
DO WHDR
+3 IF PSGWN'=PSGWNO
Begin DoDot:1
+4 if DRGO]""
DO TOT(PSGTOTD," ",53)
if TMO]""&($GET(PSGTM)!$GET(PSGTMALL))
DO TOT(PSGTOTM,MSG1_TMO,53)
if PSGWNO]""
DO TOT(PSGTOTW,MSG1_PSGWNO,53)
+5 WRITE !,"WARD: ",PSGWN
if $GET(PSGTM)!$GET(PSGTMALL)
WRITE !,"TEAM: ",TM
+6 SET DRGO=""
SET TMO=TM
SET PSGWNO=PSGWN
SET (PSGTOTD,PSGTOTM,PSGTOTW)=0
End DoDot:1
+7 IF ($GET(PSGTM)!$GET(PSGTMALL))
IF TM'=TMO
if DRGO]""
DO TOT(PSGTOTD," ",53)
if TMO]""
DO TOT(PSGTOTM,MSG1_TMO,53)
WRITE !,"TEAM: ",TM
SET TMO=TM
SET DRGO=""
SET (PSGTOTD,PSGTOTM)=0
+8 IF DRG'=DRGO
if DRGO]""
DO TOT(PSGTOTD," ",53)
WRITE !!,$EXTRACT(DRG,1,31)
SET DRGO=DRG
SET PSGTOTD=0
+9 IF '$TEST
WRITE !
+10 WRITE ?33,$EXTRACT(PNAME,1,13)_"("_$PIECE(ND,U,3)_")",?53,$JUSTIFY(+ND,5),?59,$$ENDTC^PSGMI(PSGDT),?75,$EXTRACT($PIECE(^VA(200,+$PIECE(ND,U,2),0),U,2),1,4)
+11 if ($Y+5)>IOSL
DO WHDR
+12 SET PSGTOTD=PSGTOTD+(+ND)
SET PSGTOTU=PSGTOTU+(+ND)
SET PSGTOTM=PSGTOTM+(+ND)
SET PSGTOTW=PSGTOTW+(+ND)
+13 QUIT
+14 ;
WHDR ;***Print ward/ward group header
+1 DO HDR
+2 if $GET(PSJSTOP)
QUIT
+3 WRITE !!,"DRUG NAME",?33,"PATIENT",?54,"UNIT",?59,"DATE",?75,"DISP.",!,?59,"DISPENSED",?75,"BY",!
+4 FOR X=1:1:80
WRITE "="
+5 WRITE !
+6 QUIT
+7 ;
