source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULMED1.m@ 1078

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1TIULMED1 ; SLC/JM - Active/Recent Med Objects Routine ;2/7/2000
2 ;;1.0;TEXT INTEGRATION UTILITIES;**38,73,92,94,202,226**;Jun 20, 1997;Build 1
3 ;
4 ; All routines here are part of the LIST entry point of TIULMED
5 ;
6ADD(TXT) ; Saves TXT in TARGET
7 S NEXTLINE=NEXTLINE+1
8 I TAB S TXT=" "_TXT
9 I TAB,HEADER S TXT=" "_TXT
10 S @TARGET@(NEXTLINE,0)=TXT
11 Q
12ADDLNUM(TXT) ; Add text with Line Number added to front of string
13 S TAB=0
14 I HEADER D ADD($E(COUNT_") ",1,5)_TXT) I 1
15 E D ADD(TXT)
16 S TAB=1
17 Q
18ADDL(TXT) ; Add with ADDLNUM on FIRST
19 I FIRST D I 1
20 .D ADDLNUM(TXT)
21 .S FIRST=0
22 E D ADD(TXT)
23 Q
24ADDMED(XMODE) ; if XMODE creates XSTR, if not add med to TARGET
25 N DATA,FIRST,XSUM,XCOUNT,TOPLINE,WSTATUS
26 S FIRST=1
27 I XMODE S (XSUM,XCOUNT)=0,XSTR=""
28 E D
29 .S TOPLINE=NEXTLINE+1,DATA="",WSTATUS=0
30 .D ADDP(2)
31 I TYPE="UD" D I 1 ; Unit Dose Meds
32 .I 'XMODE D
33 ..I DETAILED D FLUSH S DATA="Give:"
34 ..S DATA=DATA_" "
35 .I $$PL(6) D ADDP(6) I 1
36 .E I $$PL(7) D ADDP(7) I 1
37 .E D ADDM("SIG")
38 .D ADDM("MDR"),ADDM("SCH")
39 .I DETAILED D FLUSH
40 .D ADDM("SIO")
41 E I TYPE="OP" D I 1 ; Outpatient Meds
42 .I 'XMODE,DETAILED D
43 ..I $$PL(12) D
44 ...S DATA=DATA_" Qty:"
45 ...D ADDP(12)
46 ..I $$PL(11) D
47 ...S DATA=$$STRIP(DATA_" for")
48 ...D ADDP(11)
49 ...S DATA=$$STRIP(DATA_" days")
50 ..D WRAP
51 .I $$ML("SIG") D I 1
52 ..I 'XMODE,DETAILED S DATA=$$STRIP(DATA_" Sig:")
53 ..D ADDM("SIG")
54 .E D ADDM("SIO"),ADDM("MDR"),ADDM("SCH")
55 E I TYPE="IV" D ; IV meds
56 .I DETAILED D FLUSH
57 .D ADDM("A")
58 .I $$ML("B") D
59 ..I 'XMODE S DATA=$$STRIP(DATA_" in")
60 ..D ADDM("B")
61 .D ADDP(3)
62 .I DETAILED D FLUSH
63 .;ELR/VMP patch 226 add route and schedule to IV's
64 .D ADDM("SIO"),ADDM("MDR"),ADDM("SCH")
65 .D FLUSH
66 .I 'XMODE D
67 ..N I
68 ..F I=TOPLINE:1:NEXTLINE S @TARGET@(I,0)=$TR(@TARGET@(I,0),U," ")
69 I XMODE D I 1
70 .I XSTR="" S XSTR="_"
71 .E I $L(XSTR)>80 S XSTR=$E(XCOUNT_"_"_XSUM_"_"_XSTR,1,80)
72 E D
73 .D FLUSH
74 .S WSTATUS=1
75 .D ADDP(9)
76 .S WSTATUS=0
77 .I DETAILED D
78 ..D ADDDATE(TOPLINE,$S(MEDTYPE=OUTPTYPE:"Issu",1:"Strt"),15)
79 ..I MEDTYPE=OUTPTYPE D I 1
80 ...N I
81 ...I TOPLINE=NEXTLINE S I=TOPLINE+1
82 ...E I $L(@TARGET@(TOPLINE+1,0))<48 S I=TOPLINE+1
83 ...E S I=TOPLINE+2
84 ...F Q:(I'>NEXTLINE) D ADD(" ")
85 ...S @TARGET@(I,0)=$E(@TARGET@(I,0)_SPACE60,1,47)_"Refills: "_+$P(NODE,U,5)
86 ...D ADDDATE(TOPLINE+1,"Last",10)
87 ...D ADDDATE(TOPLINE+2,"Expr",4)
88 ..E D
89 ...D ADDDATE(TOPLINE+1,"Stop",4)
90 Q
91FDT(PNUM) ;Returns formatted date from piece number
92 N X,Y
93 S Y=$P(NODE,U,PNUM)
94 S X=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_$E($E(Y,1,3)+1700,3,4)
95 Q X
96ADDDATE(LINENUM,TXT,PNUM) ;Add date to TARGET
97 I $$PL(PNUM) D
98 .F Q:(LINENUM'>NEXTLINE) D ADD(" ")
99 .S @TARGET@(LINENUM,0)=$E(@TARGET@(LINENUM,0)_SPACE60,1,60)_TXT_":"_$$FDT(PNUM)
100 Q
101XSUMS(STR,NOADD) ; XSUMs a string
102 N IDX,LEN
103 S LEN=$L(STR) I LEN'>0 Q
104 I '$G(NOADD),$L(XSTR)<99 S XSTR=XSTR_STR
105 F IDX=1:1:LEN S XCOUNT=XCOUNT+1,XSUM=XSUM+($A(STR,IDX)*XCOUNT)
106 Q
107WRAP ; Wraps DATA to the output
108 I XMODE Q
109 N IDX,LEN,MAX,DATA1,DONE
110 S DONE=0
111 F Q:DONE D
112 .I WSTATUS S MAX=13
113 .E D
114 ..I FIRST S MAX=41
115 ..E S MAX=39
116 ..I 'HEADER S MAX=MAX+5
117 ..I 'DETAILED S MAX=MAX+13
118 .S LEN=$L(DATA)
119 .I 'WSTATUS,LEN<MAX S DONE=1 Q
120 .I LEN<MAX S IDX=LEN
121 .E F IDX=MAX:-1:2 Q:$E(DATA,IDX)=" "
122 .I IDX<3 S IDX=MAX-1
123 .S DATA1=$$STRIP($E(DATA,1,IDX))
124 .I WSTATUS D I 1
125 ..S @TARGET@(TOPLINE,0)=$E(@TARGET@(TOPLINE,0)_SPACE60,1,LLEN)_DATA1
126 .E D ADDL(DATA1)
127 .S DATA=$$STRIP($E(DATA,IDX+1,999))
128 .I WSTATUS D
129 ..S DONE=1,WSTATUS=0
130 ..I $L(DATA)>0 D
131 ...I TOPLINE'<NEXTLINE D ADD(" ")
132 ...S @TARGET@(TOPLINE+1,0)=$E(@TARGET@(TOPLINE+1,0)_SPACE60,1,LLEN)_DATA
133 ...S DATA=""
134 Q
135STRIP(X) ; Removes Leading and Trialing Spaces
136 F Q:$E(X)'=" " S X=$E(X,2,999)
137 F Q:$E(X,$L(X))'=" " S X=$E(X,1,$L(X)-1)
138 Q X
139ADDP(PNUM) ; Adds or XSUMs a piece of NODE
140 I XMODE D I 1
141 .D XSUMS(PNUM,1)
142 .D XSUMS($P(NODE,U,PNUM))
143 E D
144 .N VALUE
145 .S VALUE=$P(NODE,U,PNUM)
146 .I PNUM=9,VALUE="ACTIVE/SUSP" S VALUE="ACTIVE (S)"
147 .S DATA=$$STRIP(DATA_" "_VALUE)
148 .D WRAP
149 Q
150ADDM(SUB,FORCE) ; Adds or XSUMs Multiple
151 N IDX
152 S IDX=0
153 I XMODE D I 1
154 .D XSUMS(SUB,1)
155 .F S IDX=$O(^TMP("PS",$J,INDEX,SUB,IDX)) Q:IDX="" D
156 ..D XSUMS(^TMP("PS",$J,INDEX,SUB,IDX,0))
157 E D
158 .I $G(FORCE),DETAILED D FLUSH
159 .F S IDX=$O(^TMP("PS",$J,INDEX,SUB,IDX)) Q:IDX="" D
160 ..S DATA=$$STRIP(DATA_" "_^TMP("PS",$J,INDEX,SUB,IDX,0))
161 ..D WRAP
162 Q
163FLUSH ; Flush the DATA buffer
164 I 'XMODE,DATA'="" D
165 .D WRAP
166 .I DATA'="" D ADDL(DATA) S DATA=""
167 Q
168PL(PNUM) ;Retuns length of peice
169 Q $L($P(NODE,U,PNUM))
170ML(SUB) ;Returns true if multiple exists and contains data
171 N IDX,ML
172 S (IDX,ML)=0
173 F S IDX=$O(^TMP("PS",$J,INDEX,SUB,IDX)) Q:(IDX="")!ML D
174 .I $L(^TMP("PS",$J,INDEX,SUB,IDX,0)) S ML=1
175 Q ML
176ADDTITLE ;Adds a title line indicating which meds are in the list
177 N MSG,ALL,SUP,SUPFX
178 I ACTVONLY<2 S MSG="Active"
179 E S MSG=""
180 I '+ACTVONLY S MSG=MSG_" and "
181 I ACTVONLY'=1 S MSG=MSG_"Recently Expired"
182 S ALL=ALLMEDS
183 I ALL=0 D
184 .I ISINP S ALL=2
185 .E S ALL=3
186 S MSG=MSG_" "
187 I ALL'=3 S MSG=MSG_"Inpatient"
188 I ALL=1 S MSG=MSG_" and "
189 I ALL'=2 S MSG=MSG_"Outpatient"
190 S MSG=MSG_" Medications"
191 I SUPPLIES S SUPFX="in"
192 E S SUPFX="ex"
193 S SUPFX="("_SUPFX_"cluding Supplies):"
194 I $L(MSG)>51 D I 1
195 .D ADD(MSG)
196 .D ADD(SUPFX)
197 E D
198 .S MSG=MSG_" "_SUPFX
199 .D ADD(MSG)
200 D ADD(" ")
201 Q
202WARNING ;Inserts warning about CLASSORT if needed
203 I CLASSORT D
204 .N MSG
205 .D ADD("* * WARNING * * Sorting by drug class may not be accurate!")
206 .D ADD("Medications belonging to multiple drug classes will only be listed")
207 .S MSG="under a single drug class."
208 .I UNKNOWNS S MSG=MSG_" In addition, the system is not able to"
209 .D ADD(MSG)
210 .I UNKNOWNS D ADD("determine the drug class of some medications.")
211 Q
Note: See TracBrowser for help on using the repository browser.