source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSHO.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 7.9 KB
Line 
1GMTSPSHO ; SLC OIFO/GS - Herbal/OTC Medications Health Summary; 01/26/2004
2 ;;2.7;Health Summary;**65**;Oct 20, 1995
3 ;v6;04/07/2004
4 ;
5 ; External References
6 ; DBIA 330 ^PSOHCSUM which includes ^TMP("PSOO",$J)
7 ; DBIA 10003 DD^%DT
8 ; DBIA 10035 ^DPT( file #2
9 ; DBAI 10060 ^VA(200
10 ;
11 ; Format of ^TMP("PS00",$J,"NVA",ILFD,0) as G1 aka GMRC
12 ; (see also ^PSOHCSUM):
13 ;
14 ; Field Descriptions Defined AKA/Notes
15 ; Orderable Item $P(G1,U) Includes dosage form
16 ; (File # 50.7)
17 ; Status $P(G1,U,2)
18 ; Discontinued Date $P(G1,U,7) FM format
19 ; Order # $P(G1,U,4) CPRS Order # ptr to
20 ; File #100
21 ; Documented By $P($P(G1,U,6),";",2) Doc. by Name ptr to
22 ; File #200 is $P(x;1)
23 ; Documented Date $P(G1,U,5) FM format (Entered On)
24 ; Clinic $P($P(G2,U,5),";",2) Clinic Name ptr to
25 ; File #44 is $P(x;1)
26 ; Date Started $P(G1,U,3) FM format (Start Date)
27 ; Drug $P($P(G2,U,4),";",2) Drug name (Dispensed)
28 ; ptr to f#50 is $P(x;1)
29 ; Dosage $P(G2,U)
30 ; Medication Route $P(G2,U,2)
31 ; Schedule $P(G2,U,3)
32 ; Statement/Explanation ^TMP("PSOO",$J,"NVA",ILFD,"DSC",nn,0)
33 ;
34 ; where G1=^TMP("PSOO",$J,"NVA",ILFD,0)
35 ; G2=^TMP("PSOO",$J,"NVA",ILFD,1,0)
36 ; nn & nnn = sequentual integers
37 ;
38 ; Variables Descriptions
39 ; CT Counter of number of Herbal/OTC/Non-VA drugs for patient
40 ; DFN Patient internal number passed in
41 ; DGR Documented by's degree
42 ; ILFD Inverse Last Fill Date (FM format)
43 ; JOB $J
44 ; G1,G2 Abstracted data strings from ^TMP("PSOO", - see MAIN & WRT
45 ; GMT* Variables used by HS pagination routine (GMTSUP), e.g.,
46 ; GMTSLPG=last page, GMTSTITL=title
47 ; LL* Line lengths ('^' delimited) for override reason & S/E
48 ; NEWFORM ;
49 ; NL Sequential line counter for override reasons &
50 ; statement/explanation
51 ; T1,T2,T3 Integer tab stops for data display - see MAIN
52 ; T4 Tab stops (#,#) for override reason display
53 ; T5 Tab stops for Stmt/Expln display
54 ; V Line header verbiage describing data displayed
55 ; VARY Array of verbiage to be displayed (override reason & S/E)
56 ; Y Scratch system variable
57 ;
58 ; Global Variables (variables defined outside this routine)
59 ; DFN, GMTSNPG, GMTSQIT
60 ;
61MAIN ; Herbal/Over-the-Counter/Non-VA Medications
62 N CHAW,CLL,CT,DGR,G1,G2,GMTOP,GMX,I,ILFD,ILN,JOB,LINE,LL
63 N LL5,LP,MAX,NL,OLN,PLN,T1,T2,T3,T4,T5,V,VARY,VO,X,Y
64 S ILFD=0,JOB=$J,LL5="40^65"
65 S T1=16,T2=58,T3=33,T4="25,10",T5="33,10"
66 ; Set variables for use by report pagination routine (GMTSUP)
67 S CT=0,MAX=999,GMX=0
68 ; Check to see if a patient IEN is defined
69 I DFN="" D CKFORM W !?8,"No patient selected" Q
70 ; Check page line count and print new page and header if necessary
71 D CKFORM Q:$D(GMTSQIT)
72 ; Output header for report
73 D:GMTSNPG!(GMX'>0) HDR Q:$D(GMTSQIT) D CKFORM Q:$D(GMTSQIT)
74 W:'GMTOP ! S GMTOP=0,GMX=1
75 ; Run Pharmacy extraction
76 D ^PSOHCSUM ; DBIA 330
77 ; Quit if no herbals/non-VA drugs extracted - ^TMP("PSOO") via DBIA 330
78 I '$D(^TMP("PSOO",JOB,"NVA")) D CKFORM W !,?8,"No Non-VA Meds Extracted" Q
79 ; Loop through ^TMP global array created by ^PSOHCSUM ; DBIA 330
80 ; Quit if 1 Inverse Last Fill Date =0
81 ; 2 Counter is not less than Max Occurrence
82 ; 3 User has "up-arrowed" out of the display
83 F S ILFD=$O(^TMP("PSOO",JOB,"NVA",ILFD)) Q:+ILFD=0!(CT'<MAX)!($D(GMTSQIT)) D
84 . S G1=^TMP("PSOO",JOB,"NVA",ILFD,0)
85 . S G2=^TMP("PSOO",JOB,"NVA",ILFD,1,0),CT=CT+1
86 . D WRT
87 K ^TMP("PSOO",$J) ;delete temporary file created via PSOHCSUM
88 Q
89 ;
90WRT ; Write Data
91 D CKFORM Q:$D(GMTSQIT) ;line/pagination check - repeated ad nauseum
92 D:GMTSNPG!(GMX'>0) HDR Q:$D(GMTSQIT)
93 D CKFORM Q:$D(GMTSQIT)
94 S V="Non-VA Med: " W !?T1-$L(V),V,$P(G1,U)
95 D CKFORM Q:$D(GMTSQIT)
96 S V="Status: " W !?T1-$L(V),V,$P(G1,U,2)
97 ; Display discontinued date if it exists (assume discontinued status)
98 S Y=$P(G1,U,7) I Y D DD^%DT W " (",$P(Y,"@"),")" ; DBIA 10003
99 S V="CPRS Order #: " W ?T2-$L(V),V,$P(G1,U,4)
100 D CKFORM Q:$D(GMTSQIT)
101 S V="Documented By: " W !?T1-$L(V),V,$P($P(G1,U,6),";",2)
102 I $P($P(G1,U,6),";") D DEGREE W:DGR'="" ",",DGR
103 S V="Documented Date: ",Y=$P(G1,U,5) D DD^%DT W ?T2-$L(V),V,Y ; DBIA 10003
104 D CKFORM Q:$D(GMTSQIT)
105 S V="Clinic: "
106 W !?T1-$L(V),V,$P($P(G2,U,5),";"),"-",$P($P(G2,U,5),";",2)
107 S V="Start Date: ",Y=$P(G1,U,3) D DD^%DT W ?T2-$L(V),V,Y ; DBIA 10003
108 D CKFORM Q:$D(GMTSQIT)
109 S V="Dispense Drug: " W !?T1-$L(V),V,$P($P(G2,U,4),";",2)
110 S V="Dosage: " W ?T2-$L(V),V,$P(G2,U)
111 D CKFORM Q:$D(GMTSQIT)
112 S V="Med Route: " W !?T1-$L(V),V,$P(G2,U,2)
113 S V="Schedule: " W ?T2-$L(V),V,$P(G2,U,3)
114 S V="Statement/Explanation/Comment: ",NL=""
115 D CKFORM Q:$D(GMTSQIT)
116 W !
117 D CKFORM Q:$D(GMTSQIT)
118 W !?T3-$L(V),V
119 K V M V=^TMP("PSOO",JOB,"NVA",ILFD,"DSC")
120 ; Statement/Explanation verbiage
121 D LINES(LL5,.V) K V D LINESOUT(T5)
122 D CKFORM W !
123 K VO,X,Y
124 Q
125 ;
126LINESOUT(TN) ;WRITE LINES
127 F S NL=$O(VO(NL)) Q:NL=""!$D(GMTSQIT) D
128 . I NL=1 W ?$P(TN,","),VO(NL)
129 . E D CKFORM Q:$D(GMTSQIT) W !?$P(T4,",",2),VO(NL)
130 Q
131 ;
132LINES(LL,V) ;BREAK LINES OF AN ARRAY INTO APPROPRIATE MAX LENGTHS
133 ;
134 ; Input:
135 ; LL = line lengths, e.g., 20^30^40 where last remains default
136 ; V = input array w/ no null lines, use " " for blank line
137 ;
138 ;Output:
139 ; OV = output array of lines broken into specified maximum lengths
140 ;
141 ; This subroutine takes an array of text (V) and breaks the text into
142 ; line lengths as dictated via LL. Where the first line length (max)
143 ; of the resulting array (VO) will be (approximately, based on line
144 ; contents) $P(LL,"^",1), the second line length (max) will be
145 ; $P(LL,"^",2), etc. The last line length in LL becomes the default
146 ; maximum line length for all the remaining lines.
147 ;
148 ; This subroutine is useful if you want lines output in different
149 ; lengths.
150 ;
151 ; Variables used:
152 ; CHAW = the next piece of a line of a maximum byte length
153 ; CLL = current line length (max)
154 ; I = scratch variable
155 ; ILN = input array line number
156 ; LP = pointer indicating where in a line the last chaw taken
157 ; OLN = output (resulting) line number
158 ; PLN = previous line length (max)
159 ; X = line being parsed for a breaking point
160 ;
161 N CHAW,CLL,ILN,LP,OLN,PLN
162 K VO
163 S (I,ILN,X)="",OLN=1,CLL=$P(LL,U,OLN),PLN=CLL
164 F S ILN=$O(V(ILN)) Q:ILN="" S LP=1 D
165 . S I=$E($RE(V(ILN,0)))
166 . S V(ILN,0)=V(ILN,0)_$S("!?."[I:" ",",;:"[I!(I?1A):" ",1:"")
167 . I V(ILN,0)=" " S:X'="" VO(OLN)=X,X="",OLN=OLN+1 S VO(OLN)=" ",OLN=OLN+1 Q
168 . F S CHAW=$E(V(ILN,0),LP,LP+CLL-$L(X)),LP=LP+$L(CHAW),X=X_CHAW Q:CHAW=""!($L(X)<CLL) D
169 .. I $L(X)<CLL S VO(OLN)=X,X="" D LINESET Q
170 .. I X'[" "&($L(X)=CLL) S VO(OLN)=X_"-",X="" D LINESET Q
171 .. F I=$L(X):-1:1 Q:$E(X,I)=" "!($E(X,I)="-")
172 .. S VO(OLN)=$E(X,1,I),X=$E(X,I+1,999) D LINESET
173 S:X'="" VO(OLN)=X
174 Q
175 ;
176LINESET ; Used by LINES for setting variables
177 S OLN=OLN+1,PLN=CLL,CLL=$P(LL,U,OLN) S:+CLL=0 CLL=PLN
178 Q
179 ;
180CKFORM ; Checks to determine whether to do a form feed or not
181 D CKP^GMTSUP Q:$D(GMTSQIT)
182 Q
183 ;
184HDR ; Prints Header
185 S GMTOP=1
186 I GMX'>0 D CKP^GMTSUP Q:$D(GMTSQIT)
187 I 'GMTSNPG D CKP^GMTSUP Q:$D(GMTSQIT)
188 Q
189 ;
190DEGREE ; Gets degree of 'Documented by' individual & converts to upper case
191 S DGR=$$GET1^DIQ(200,$P($P(G1,U,6),";"),10.6) ; DBIA 10060
192 S DGR=$TR(DGR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
193 Q
Note: See TracBrowser for help on using the repository browser.