source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBOHDR.m@ 979

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1PSBOHDR ;BIRMINGHAM/EFC-REPORT HEADERS ;Mar 2004
2 ;;3.0;BAR CODE MED ADMIN;**5,13**;Mar 2004
3 ;
4 ; Reference/IA
5 ; EN6^GMRVUTL/1120
6 ; WARD^NURSUT5/3052
7 ; IN5^VADPT/10061
8 ; DEM^VADPT/10061
9 ;
10PT(DFN,PSBHDR,PSBCONT,PSBDT) ;
11 ; DFN: Patient File IEN
12 ; PSBCONT: True if this is a continuation page
13 ; PSBDT: Date of Pt Information (Default to DT)
14 W:$Y>1 @IOF
15 W:$X>1 !
16 S:'$G(PSBDT) PSBDT=DT
17 ; BUILD PSBHDR WITH ALL HEADER STUFF
18 D:'$D(PSBHDR("NAME"))
19 .S VAIP("D")="LAST"
20 .D DEM^VADPT,IN5^VADPT
21 .S PSBHDR("NAME")=VADM(1)
22 .S PSBHDR("SSN")=$P(VADM(2),U,2)
23 .S PSBHDR("DOB")=$P(VADM(3),U,2)
24 .S PSBHDR("AGE")=VADM(4)
25 .S PSBHDR("SEX")=$P(VADM(5),U,2)
26 .S PSBHDR("MVMTTYPE")=$P(VAIP(2),U,2)
27 .S PSBHDR("MVMTLAST")=$P(VAIP(3),U,2)
28 .S PSBHDR("WARD")=$P(VAIP(5),U,2)
29 .S PSBHDR("ROOM")=$P(VAIP(6),U,2)
30 .S PSBHDR("DX")=VAIP(9)
31 .K VAIP,VADM
32 .S GMRVSTR="HT" D EN6^GMRVUTL
33 .S X=+$P(X,U,8) S:X X=X*2.54\1 S PSBHDR("HEIGHT")=$S(X:X_"cm",1:"*")
34 .S GMRVSTR="WT" D EN6^GMRVUTL
35 .S X=+$P(X,U,8) S:X X=X*.45\1 S PSBHDR("WEIGHT")=$S(X:X_"kg",1:"*")
36 .N PSBADRX D ALLR^PSBALL(.PSBADRX,DFN) S X=0,Y=""
37 .F S X=$O(PSBADRX(X)) Q:'X D
38 ..Q:$P(PSBADRX(X),U,1)'="ADR" S Z=$P(PSBADRX(X),U,2) Q:Z=""
39 ..I $L(Y_Z)>(IOM-22) S PSBHDR("REAC",$O(PSBHDR("REAC",""),-1)+1)=Y,Y=""
40 ..S Y=Y_$S(Y]"":", ",1:"")_$P(PSBADRX(X),U,2)
41 .S:Y]"" PSBHDR("REAC",$O(PSBHDR("REAC",""),-1)+1)=Y
42 .I '$D(PSBHDR("REAC")) S PSBHDR("REAC",1)="No ADRs on file."
43 .D PSBALG
44 .K GMRAL,GMRVSTR,GMRA,PSBARX
45 .D NOW^%DTC S Y=+$E(%,1,12) D D^DIQ S PSBHDR("DATE")="Run Date: "_Y
46 .S PSBHDR("PAGE")=0
47 W $C(13),$TR($J("",IOM)," ","=")
48 W !,$G(PSBHDR(0))
49 W !,$G(PSBHDR(1)),?(IOM-$L(PSBHDR("DATE"))),PSBHDR("DATE")
50 S PSBHDR("PAGE")=PSBHDR("PAGE")+1
51 W !,$G(PSBHDR(2)),?(IOM-10),$J("Page: "_PSBHDR("PAGE"),10)
52 F X=3:1 Q:'$D(PSBHDR(X)) W !,PSBHDR(X) ; More Lines If Needed
53 I $G(PSBCONT) W !?(IOM-35\2),"*** CONTINUED FROM PREVIOUS PAGE ***"
54 W !!,"Patient:",?10,PSBHDR("NAME")
55 W ?40,"SSN: ",PSBHDR("SSN")
56 W ?75,"DOB:",?82,PSBHDR("DOB")," (",PSBHDR("AGE"),")"
57 D:'$G(PSBCONT)
58 .W !,"Sex: ",?10,PSBHDR("SEX"),?40,"Ht/Wt: ",PSBHDR("HEIGHT"),"/",PSBHDR("WEIGHT"),?75,"Ward: ",?82,PSBHDR("WARD")," Rm ",PSBHDR("ROOM")
59 .W !,"Dx:",?10,PSBHDR("DX"),?40,"Last Mvmt: ",PSBHDR("MVMTLAST"),?75,"Type: ",PSBHDR("MVMTTYPE")
60 .; Reactions/Allergies
61 .W !!,"ADRs:"
62 .F X=0:0 S X=$O(PSBHDR("REAC",X)) Q:'X W:$X>12 ! W ?12,PSBHDR("REAC",X)
63 .W !!,"Allergies:"
64 .F X=0:0 S X=$O(PSBHDR("ALERGY",X)) Q:'X W:$X>12 ! W ?12,PSBHDR("ALERGY",X)
65 .; Local Mods Allowed Here and showup only on First Page
66 .; Immunizations
67 .;D SHOT80^ASFSHOTF
68 W !,$TR($J("",IOM)," ","=")
69 Q
70 ;
71WARD(PSBWP,PSBHDR,PSBCONT,PSBDT) ;
72 ; WARD: Nurse Location File IEN
73 ; PSBCONT: True if this is a continuation page
74 ; PSBDT: Date of Pt Information (Default to DT)
75 N PSBWRDA
76 S:'$G(PSBDT) PSBDT=DT
77 I '$D(PSBHDR("DATE")) D NOW^%DTC S Y=+$E(%,1,12) D D^DIQ S PSBHDR("DATE")="Run Date: "_Y
78 S:'$D(PSBHDR("PAGE")) PSBHDR("PAGE")=0
79 W:$Y>1 @IOF
80 W:$X>0 !
81 W $TR($J("",IOM)," ","="),!,$G(PSBHDR(0)),!,$G(PSBHDR(1)),?(IOM-$L(PSBHDR("DATE"))),PSBHDR("DATE")
82 S PSBHDR("PAGE")=PSBHDR("PAGE")+1
83 W !,$G(PSBHDR(2)),?(IOM-10),$J("Page: "_PSBHDR("PAGE"),10)
84 F X=3:1 Q:'$D(PSBHDR(X)) W !,PSBHDR(X) ; More Lines If Needed
85 I $G(PSBCONT) W !?(IOM-35\2),"*** CONTINUED FROM PREVIOUS PAGE ***"
86 D WARD^NURSUT5("L^"_PSBWP,.PSBWRDA)
87 W !!,"Ward Location: "_$P(PSBWRDA(PSBWP,.01),U,2)
88 S X="Division: "_$P(PSBWRDA(PSBWP,.02),U,2)
89 W ?(IOM-$L(X)),X,!,$TR($J("",IOM)," ","=")
90 Q
91 ;
92PSBALG ;
93 S YA=""
94 K PSBAL,GMRALA
95 S PSBLIST=""
96 D ALLR^PSBALL(.GMRALA,DFN)
97 S X="" F S X=$O(GMRALA(X)) Q:X="" D
98 .I $P(GMRALA(X),U,1)["ALL" D
99 ..S PSBAL($P(GMRALA(X),U,2))=""
100 S XAB="" F S XAB=$O(PSBAL(XAB)) Q:XAB="" D
101 .S Z=XAB
102 .I $L(YA_Z)>(IOM-22) S PSBHDR("ALERGY",$O(PSBHDR("ALERGY",""),-1)+1)=YA,YA=""
103 .S YA=YA_$S(YA]"":", ",1:"")_XAB
104 S:YA]"" PSBHDR("ALERGY",$O(PSBHDR("ALERGY",""),-1)+1)=YA
105 I '$D(PSBHDR("ALERGY")) S PSBHDR("ALERGY",1)="No Allergies on file."
106 Q
107 ;
108PTFTR() ; [Extrinsic] Patient Page footer
109 ;
110 I (IOSL<100) F Q:$Y>(IOSL-6) W !
111 W !,$TR($J("",IOM)," ","=")
112 S X="Ward: "_PSBHDR("WARD")_" Room-Bed: "_PSBHDR("ROOM")
113 W !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$L(X)),X
114 I $G(PSBUNK) S X="Note: ?? Indicates an administration with an *UNKNOWN* Action Status" W !!,X
115 Q ""
116 ;
Note: See TracBrowser for help on using the repository browser.