source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBFRM2.m@ 1389

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

initial load of WorldVistAEHR

File size: 5.6 KB
RevLine 
[613]1ALPBFRM2 ;OIFO-DALLAS MW,SED,KC-SCREEN DISPLAY FORMATTING UTIL ;01/01/03
2 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
3 ;
4F80(DATA,MLDATE,RESULTS) ; format basic output for screen (80-column) display...
5 ; DATA = array passed by reference containing the data record to be formatted
6 ; MLDATE = a date from which med log data is retrieved
7 ; returns RESULTS array with formatted output (note: total lines returned in RESULTS(0))
8 N ALPBCMNT,ALPBMDT,ALPBTEXT,ALPBX,LINE
9 S RESULTS(0)=0
10 S RESULTS(1)=" Order Number: "_$S($P($G(DATA(0)),"^")'="":$P(DATA(0),"^"),1:"??")
11 S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),50)_"Start: "
12 S RESULTS(1)=RESULTS(1)_$S($P($G(DATA(1)),"^")'="":$$FMTE^XLFDT($P(DATA(1),"^")),1:"<not on file>")
13 S RESULTS(2)=" Type: "_$$OTYP^ALPBUTL($P(DATA(3),"^"))
14 S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),51)_"Stop: "
15 S RESULTS(2)=RESULTS(2)_$S($P($G(DATA(1)),"^",2)'="":$$FMTE^XLFDT($P(DATA(1),"^",2)),1:"<not on file>")
16 S RESULTS(3)=" Status: "_$P($P(DATA(0),"^",3),"~",2)
17 S LINE=3
18 ; drug(s)...
19 I +$O(DATA(7,0)) D
20 .S LINE=LINE+1
21 .S RESULTS(LINE)=" Drug: "
22 .S ALPBX=0
23 .F S ALPBX=$O(DATA(7,ALPBX)) Q:'ALPBX D
24 ..S RESULTS(LINE)=$G(RESULTS(LINE))_$P(DATA(7,ALPBX,0),"^",2)
25 ..I +$O(DATA(7,ALPBX)) D
26 ...S LINE=LINE+1
27 ...S RESULTS(LINE)=" "
28 ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
29 .K ALPBX
30 ;
31 ; any additives...
32 I +$O(DATA(8,0)) D
33 .S LINE=LINE+1
34 .S RESULTS(LINE)="Additive Info: "
35 .S ALPBX=0
36 .F S ALPBX=$O(DATA(8,ALPBX)) Q:'ALPBX D
37 ..S RESULTS(LINE)=RESULTS(LINE)_$P(DATA(8,ALPBX,0),"^",2)
38 ..; if UNITS isn't already contained in ADDITIVE NAME, add it...
39 ..I $P(DATA(8,ALPBX,0),"^",3)'=""&($P(DATA(8,ALPBX,0),"^",2)'[$P(DATA(8,ALPBX,0),"^",3)) S RESULTS(LINE)=RESULTS(LINE)_" "_$P(DATA(8,ALPBX,0),"^",3)
40 ..I +$O(DATA(8,ALPBX)) D
41 ...S LINE=LINE+1
42 ...S RESULTS(LINE)=" "
43 ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
44 .K ALPBX
45 ;
46 ; any solutions...
47 I +$O(DATA(9,0)) D
48 .S LINE=LINE+1
49 .S RESULTS(LINE)="Solution Info: "
50 .S ALPBX=0
51 .F S ALPBX=$O(DATA(9,ALPBX)) Q:'ALPBX D
52 ..S RESULTS(LINE)=RESULTS(LINE)_$P(DATA(9,ALPBX,0),"^",2)
53 ..; if UNITS isn't already contained in SOLUTION NAME, add it...
54 ..I $P(DATA(9,ALPBX,0),"^",3)'=""&($P(DATA(9,ALPBX,0),"^",2)'[$P(DATA(9,ALPBX,0),"^",3)) S RESULTS(LINE)=RESULTS(LINE)_" "_$P(DATA(9,ALPBX,0),"^",3)
55 ..I +$O(DATA(9,ALPBX)) D
56 ...S LINE=LINE+1
57 ...S RESULTS(LINE)=" "
58 ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
59 .K ALPBX
60 ;
61 ; give ($P(DATA(4),"^",1)=DOSAGE $P(DATA(4),"^",2)=ROUTE $P(DATA(4),"^",3)=SCHEDULE)...
62 S LINE=LINE+1
63 S RESULTS(LINE)=" Give: "_$P($G(DATA(4)),"^")_" "_$P($G(DATA(4)),"^",2)_" "_$P($G(DATA(4)),"^",3)
64 ; provider, pharmacist or entry person, and verifier...
65 S LINE=LINE+1
66 S RESULTS(LINE)=" Provider: "_$P($G(DATA(2)),"^")
67 S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),43)_"RPh/Entry by: "_$P($G(DATA(2)),"^",2)
68 I $P($G(DATA(2)),"^",3)'="" D
69 .S LINE=LINE+1
70 .S RESULTS(LINE)=" Verified by: "_$P(DATA(2),"^",3)
71 ; administration times...
72 S LINE=LINE+1
73 S RESULTS(LINE)=" Admin. Times: "_$P($G(DATA(4)),"^",4)
74 ; provider comments, special instructions or other print info...
75 I +$O(DATA(5,0)) D
76 .M ALPBCMNT=DATA(5)
77 .D FTEXT^ALPBFRMU(78,.ALPBCMNT,.ALPBTEXT)
78 .K ALPBCMNT
79 .S ALPBX=0
80 .F S ALPBX=$O(ALPBTEXT(ALPBX)) Q:'ALPBX D
81 ..S LINE=LINE+1
82 ..S RESULTS(LINE)=ALPBTEXT(ALPBX,0)
83 .K ALPBTEXT,ALPBX
84 ; med log data...
85 I +$O(DATA(10,0)) D
86 .S LINE=LINE+1
87 .S RESULTS(LINE)="BCMA Medication Log History since "_$$FMTE^XLFDT(MLDATE)
88 .S LINE=LINE+1
89 .S RESULTS(LINE)=" Log Date"
90 .S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_"Message"
91 .S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_"Log Entry Person"
92 .I $O(DATA(10,"B",MLDATE))="" D
93 ..S LINE=LINE+1
94 ..S RESULTS(LINE)="No entries to report."
95 .S ALPBMDT=MLDATE
96 .F S ALPBMDT=$O(DATA(10,"B",ALPBMDT)) Q:'ALPBMDT D
97 ..S ALPBX=0
98 ..F S ALPBX=$O(DATA(10,"B",ALPBMDT,ALPBX)) Q:'ALPBX D
99 ...S LINE=LINE+1
100 ...S RESULTS(LINE)=" "_$$FDATE^ALPBUTL(ALPBMDT)
101 ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$P(DATA(10,ALPBX,0),"^",3)
102 ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_$S($P(DATA(10,ALPBX,0),"^",2)'="":$P(DATA(10,ALPBX,0),"^",2),1:"<not on file>")
103 ..K ALPBX
104 .K ALPBMDT
105 S LINE=LINE+1
106 S RESULTS(LINE)=$$REPEAT^XLFSTR("-",80)
107 S RESULTS(0)=LINE
108 Q
109 ;
110HDR(DATA,TYPE,PG,RESULTS) ; screen display header...
111 ; DATA = array passed by reference containing the data record to be formatted
112 ; TYPE = either 'A' for ALL orders or 'C' for CURRENT orders. if null, not used in construction
113 ; of first line of returned array
114 ; PG = page number
115 ; RESULTS = an array passed by reference into which the formatted output will be saved
116 ; returns RESULTS array with formatted output (note: total lines returned in RESULTS(0))
117 N ALPBX,LINE
118 I $G(TYPE)="" S TYPE="X"
119 I $G(PG)="" S PG=0
120 S RESULTS(0)=0
121 S RESULTS(1)=$S(TYPE="A":"ALL ",TYPE="C":"CURRENT ",1:"")_"ORDERS"
122 S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),70)_"Page: "_$J(PG,3)
123 S RESULTS(2)=$P($G(DATA(0)),"^")
124 S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),32)_"SSN: "_$P($G(DATA(0)),"^",2)
125 S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),48)_"Ward: "_$P($G(DATA(0)),"^",5)
126 S RESULTS(3)="This record last updated: "_$S($P(DATA(0),"^",8)'="":$$FMTE^XLFDT($P(DATA(0),"^",8)),1:"<date not on file>")
127 S RESULTS(3)=$$PAD^ALPBUTL(RESULTS(3),48)_"Room: "_$P(DATA(0),"^",6)_" Bed: "_$P(DATA(0),"^",7)
128 S LINE=3
129 I +$O(DATA(1,0)) D
130 .S LINE=LINE+1
131 .S RESULTS(LINE)="Allergies: "
132 .S ALPBX=0
133 .F S ALPBX=$O(DATA(1,ALPBX)) Q:'ALPBX D
134 ..S RESULTS(LINE)=RESULTS(LINE)_$P(DATA(1,ALPBX,0),"^",2)
135 ..I +$O(DATA(1,ALPBX)) S RESULTS(LINE)=RESULTS(LINE)_"; "
136 S LINE=LINE+1
137 S RESULTS(LINE)=$$REPEAT^XLFSTR("-",80)
138 S RESULTS(0)=LINE
139 Q
Note: See TracBrowser for help on using the repository browser.