- 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 Feb 18, 2025@23:27:36 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 ;