source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGEUDP.m@ 1713

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
 ;