source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGEUDP.m@ 1147

Last change on this file since 1147 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1PSGEUDP ;BIR/MV-PRINT EXTRA UNITS DISP. ;04 JAN 95 / 12:27 PM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3START ;
4 ;*** The drug name will be truncated to 33 chars when print
5 ;*** by Ward/WardGroup
6 I '$D(^TMP($J)) W !!,"NO DATA FOUND ON EXTRA UNITS DISPENSED" G EXIT
7 U IO
8 NEW MSG1,MSG2,DRGO,PPNO,TMO,PNAME
9 S (PSGPG,PSJSTOP)=0
10 S MSG1="TOTAL FOR ",$P(MSG2,".",80)="."
11 D @($S(PSGSS="P":"P",1:"W"))
12EXIT D EXITDEV^PSJMUTL
13 K PSGTOTD,PSGTOTM,PSGTOTU,PSGTOTW,PSGWNO,PSGPG
14 Q
15 ;
16P ;*** Print by patient.
17 S (PPNO,DRGO)=""
18 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
19 . F PSGDT=0:0 S PSGDT=$O(^TMP($J,PPN,DRG,PSGDT)) Q:('PSGDT!$G(PSJSTOP)) D PRTPT
20 Q:$G(PSJSTOP)
21 D:DRGO]"" TOT(PSGTOTD," ",46),TOT(PSGTOTU,MSG1_$P($G(^DPT($P(PPNO,"^",2),0)),"^"),46)
22 Q
23 ;
24PRTPT ;*** Print Extra Dispensed Drug sort by patient.
25 S ND=^TMP($J,PPN,DRG,PSGDT)
26 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=""
27 I DRG'=DRGO D:DRGO]"" TOT(PSGTOTD," ",46) W !,DRG S DRGO=DRG,PSGTOTD=0
28 E W !
29 W ?46,$J(+ND,5),?53,$$ENDTC^PSGMI(PSGDT),?69,$E($P(^VA(200,+$P(ND,U,2),0),U,2),1,4)
30 D:($Y+5)>IOSL PHDR
31 S PSGTOTD=PSGTOTD+(+ND),PSGTOTU=PSGTOTU+(+ND)
32 Q
33 ;
34TOT(TOT,NAME,X) ;*** Print the total line for drug,patient,team,ward...
35 W !?2,NAME,$E(MSG2,1,X-2-$L(NAME)),?X,$J(TOT,5),!
36 Q
37 ;
38PHDR ;*** Print the header when sort by patient.
39 D HDR Q:$G(PSJSTOP)
40 W !!,PNAME,?39,"Room_Bed: "_$P(ND,U,4),!,$P(ND,U,3),?39," Ward: "_$P(ND,U,5),!
41 W !!,"DRUG NAME",?47,"UNIT",?53,"DATE",?69,"DISP."
42 W !?53,"DISPENSED",?69,"BY",!
43 Q
44HDR ;*** Print the report main header.
45 Q:$$PRTCHK^PSJMUTL(PSGPG)
46 S PSGPG=PSGPG+1 W:$Y @IOF
47 W !?30,"EXTRA UNITS DISPENSED REPORT",?68,"PAGE: ",PSGPG
48 W !?17,"REPORT FROM: ",$$ENDTC^PSGMI(PSGSDT)," TO: ",$$ENDTC^PSGMI(PSGEDT),!
49 Q
50W ;***Print by ward/ward group.
51 S (DRGO,PSGWN,PSGWNO,TMO)="",(PSGTOTD,PSGTOTM,PSGTOTU,PSGTOTW)=0
52 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
53 . 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
54 . . F PSGDT=0:0 S PSGDT=$O(^TMP($J,PSGWN,TM,DRG,PPN,PSGDT)) Q:('PSGDT!$G(PSJSTOP)) D PRTW
55 Q:$G(PSJSTOP)
56 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)
57 Q
58 ;
59PRTW ;*** Print output for ward/ward group
60 S ND=^TMP($J,PSGWN,TM,DRG,PPN,PSGDT)
61 D:'PSGPG WHDR
62 I PSGWN'=PSGWNO D
63 . D:DRGO]"" TOT(PSGTOTD," ",53) D:TMO]""&($G(PSGTM)!$G(PSGTMALL)) TOT(PSGTOTM,MSG1_TMO,53) D:PSGWNO]"" TOT(PSGTOTW,MSG1_PSGWNO,53)
64 . W !,"WARD: ",PSGWN W:$G(PSGTM)!$G(PSGTMALL) !,"TEAM: ",TM
65 . S DRGO="",TMO=TM,PSGWNO=PSGWN,(PSGTOTD,PSGTOTM,PSGTOTW)=0
66 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
67 I DRG'=DRGO D:DRGO]"" TOT(PSGTOTD," ",53) W !!,$E(DRG,1,31) S DRGO=DRG,PSGTOTD=0
68 E W !
69 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)
70 D:($Y+5)>IOSL WHDR
71 S PSGTOTD=PSGTOTD+(+ND),PSGTOTU=PSGTOTU+(+ND),PSGTOTM=PSGTOTM+(+ND),PSGTOTW=PSGTOTW+(+ND)
72 Q
73 ;
74WHDR ;***Print ward/ward group header
75 D HDR
76 Q:$G(PSJSTOP)
77 W !!,"DRUG NAME",?33,"PATIENT",?54,"UNIT",?59,"DATE",?75,"DISP.",!,?59,"DISPENSED",?75,"BY",!
78 F X=1:1:80 W "="
79 W !
80 Q
81 ;
Note: See TracBrowser for help on using the repository browser.