source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXQUTL1.m@ 1713

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

initial load of FOIAVistA 6/30/08 version
File size: 8.5 KB
Line 
1PXQUTL1 ;ISL/JVS - DEBUGGING UTILITIES ;5/1/97 08:30
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**4,29,163**;Aug 12 1996
3 ;
4 ;
5DEC(VISIT,FLENUM,VISUAL,PXQFORM) ;Test looking through DD to find fields pointing to the visit entries.
6 ;Q:'$D(^AUPNVSIT(VISIT)) ""
7 Q:'$D(DUZ) ""
8 Q:$G(PXQFORM)=""
9 ; VISIT =Visit ien to looked up and counted
10 ; VISUAL =Set to 1 if you want and interactive display of what is found
11 ; PXQFORM=The format that it is to be diplayed.
12 ;
13 ; Look for file and field
14 ;
15 N DD,PXQKY,COUNT,FIELD,FILE,GET,PIECE,PX,REF,SNDPIECE,STOP,SUB,PXQDATA
16 N PXQTYPE,VAR,UPFILE,PXQVGHN,PXQFLD,PXQLIEN,PXQKY,PXQKY1,PXQKY2,PXQKY3
17 N PXQNFLD,PXX
18 K VDD,VDDN,VDDR
19 ;
20 S PXQTYPE=$P(PXQFORM,"^",2),PXQFORM=$P(PXQFORM,"^",1) D:$G(PXQTYPE)="C" ADD2 D:$G(PXQTYPE)="D" MUST
21 S DD="^DD"
22 S FILE=""
23 F S FILE=$O(@DD@(FLENUM,0,"PT",FILE)) Q:FILE="" D
24 .S FIELD=""
25 .F S FIELD=$O(@DD@(FLENUM,0,"PT",FILE,FIELD)) Q:FIELD="" D
26 ..I $E(FILE,1,5)=19908,FLENUM=9000010 Q
27 ..S VDD(FILE,FIELD)=""
28 D EN1^PXQUTL2
29 D REF,QUE
30 K VDDN,VDDR
31 K ^TMP("PXQADDITIONAL",$J)
32 I $G(VISUAL) W !,"COUNT= "
33 Q COUNT
34 ;
35REF ;Look for all of the regular cross references and other
36 ;
37 S FILE="" F S FILE=$O(VDD(FILE)) Q:FILE="" D
38 .S FIELD="" F S FIELD=$O(VDD(FILE,FIELD)) Q:FIELD="" D
39 ..D REG
40 K VDD
41 Q
42 ;
43REG ;Look for regular cross references
44 ;
45 S STOP=0
46 I '$D(@DD@(FILE,FIELD,1)) S VDDN(FILE,FIELD)="" Q
47 S SUB=0 F S SUB=$O(@DD@(FILE,FIELD,1,SUB)) Q:SUB="" D
48 .S GET=$G(@DD@(FILE,FIELD,1,SUB,0))
49 .I $P(GET,"^",3)']"" S VDDR(FILE,SUB)=FILE_"^"_FIELD_"^"_SUB S STOP=1
50 .E S VDDN(FILE,FIELD)=""
51 Q
52QUE ;CHECK OUT CROSS REFERENCE
53 ;
54 S FILE="",FIELD="",STOP="",COUNT=0
55 F S FILE=$O(VDDR(FILE)) Q:FILE="" D
56 .S SUB=0,STOP="" F S SUB=$O(VDDR(FILE,SUB)) Q:SUB="" Q:STOP=1 S GET=$G(VDDR(FILE,SUB)) D
57 ..S REF=$G(@DD@($P(GET,"^",1),$P(GET,"^",2),1,$P(GET,"^",3),1))
58 ..I $P(REF,"""",1)["DA(1)" Q
59 ..S PIECE=$P(REF," ",2)
60 ..S SNDPIECE=$P(PIECE,"""",1,2)_""""
61 ..S PXQVGHN=$P(PIECE,"""",1,2)_""")"
62 ..I $D(@PXQVGHN) D S STOP=1
63 ...S PX=SNDPIECE_",VISIT)"
64 ...I $D(@PX) D
65 ....S PXQKY=0 F S PXQKY=$O(@PX@(PXQKY)) Q:PXQKY="" S COUNT=COUNT+1,PXB=PXQKY S:FILE=409.68 PXQENC(PXQKY)="" D
66 .....S VAR="" S VAR=$O(@PX@(PXQKY,VAR)) I VAR="" D DIS S PX=PXX Q
67 .....S PXQKY1=0 F S PXQKY1=$O(@PX@(PXQKY,PXQKY1)) Q:PXQKY1="" S PXB1=PXQKY1 D
68 ......S VAR="" S VAR=$O(@PX@(PXQKY,PXQKY1,VAR)) I VAR="" D DIS S PX=PXX Q
69 ......S PXQKY2=0 F S PXQKY2=$O(@PX@(PXQKY,PXQKY1,PXQKY2)) Q:PXQKY2="" S PXB2=PXQKY2 D
70 .......S VAR="" S VAR=$O(@PX@(PXQKY,PXQKY1,PXQKY2,VAR)) I VAR="" D DIS S PX=PXX Q
71 .......S PXQKY3=0 F S PXQKY3=$O(@PX@(PXQKY,PXQKY1,PXQKY2,PXQKY3)) Q:PXQKY3="" S PXB3=PXQKY3 D
72 ........S VAR="" S VAR=$O(@PX@(PXQKY,PXQKY1,PXQKY2,PXQKY3,VAR)) I VAR="" D DIS S PX=PXX Q
73 Q
74 ;
75DIS ;--DISPLAY
76 S PXX=PX
77 W:$G(VISUAL) !," ",SNDPIECE_","_VISIT_","_$G(PXB) S PXBIEN=$G(PXB)
78 W:$G(VISUAL) $S($G(PXB1):","_$G(PXB1),1:"") S PXBIEN=PXBIEN_","_$G(PXB1)
79 W:$G(VISUAL) $S($G(PXB2):","_$G(PXB2),1:"") S PXBIEN=PXBIEN_","_$G(PXB2)
80 W:$G(VISUAL) $S($G(PXB3):","_$G(PXB3),1:"") S PXBIEN=PXBIEN_","_$G(PXB3)
81 K ^TMP("PXQDATA",$J)
82 ;
83 ;
84 ;--REVERSE ORDER OF PXBIEN
85 S PXQIENS="" F PXQI=($L(PXBIEN,",")-1):-1:1 S PXQJ=+$P($G(PXBIEN),",",PXQI) D
86 .I PXQJ>0 S PXQIENS=PXQIENS_PXQJ_","
87 K PXBIEN
88 ;
89 ;--DO FIRST CALL TO GETS^DIQ
90 S PXQFORM2=PXQFORM
91 I FILE=8925,PXQFORM["**" S PXQFORM=".01:.999;2.1:999999"
92 I $G(PXQIENS) D GETS^DIQ(FILE,PXQIENS,PXQFORM,"NE","^TMP(""PXQDATA"",$J")
93 D ADD
94 ;
95 ;--GET NEXT FILE NUMBER
96 S UPFILE=FILE
97 F S UPFILE=$G(@DD@(UPFILE,0,"UP")) Q:UPFILE'>0 D
98 .S PXQIENS=$P($G(PXQIENS),",",2,10)
99 .I (FILE=8925!(PXX[19908)),PXQFORM["**" S PXQFORM=".01:.999;2.1:999999"
100 .I $G(PXQIENS) D GETS^DIQ(UPFILE,PXQIENS,PXQFORM,"NE","^TMP(""PXQDATA"",$J")
101 .D ADD1
102 S PXQFORM=PXQFORM2
103 ;
104 ;
105 D PRINT
106EXIT ;---CLEAN UP AND QUIT DOESN'T QUIT THE ROUTINE
107 K PXB,PXB1,PXB2,PXB3,PXQI,PXQJ
108 K PXQIENS,PXQTEST,PXQWORD
109 S VAR=""
110 Q
111PRINT ;--PRINT TO SCREEN
112 N PXQFILE,PXQIENS,PXQFIELD,PXQLEIN,PXQNAME,PXQSPAC,PXQENTRY,PXQENTR
113 N PXQX
114 S PXQLIEN=0
115 S PXQFILE="" F S PXQFILE=$O(^TMP("PXQDATA",$J,PXQFILE)) Q:PXQFILE="" D
116 .S PXQNAME=$O(@DD@(PXQFILE,0,"NM",""))
117 .S PXQSPAC="?"_(PXQLIEN+4)_","
118 .S PXQTEST=PXQSPAC_""""_"FILE = "_PXQNAME_" #"_PXQFILE
119 .S PXQIENS="" F S PXQIENS=$O(^TMP("PXQDATA",$J,PXQFILE,PXQIENS)) Q:PXQIENS="" D
120 ..S PXQLIEN=($L(PXQIENS,",")*4)
121 ..S PXQENTRY=$P(PXQIENS,",",1) ;--($L(PXQIENS,",")-1))
122 ..S PXQENTR=" RECORD #"_PXQENTRY
123 ..W $$RE^PXQUTL(""_PXQTEST_PXQENTR_"""")
124 ..S PXQFIELD="" F S PXQFIELD=$O(^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD)) Q:PXQFIELD="" D
125 ...;---NEW CODE 3/24/97
126 ...D FIELD^DID(PXQFILE,PXQFIELD,"","TYPE","PXQWORD","PXQWORD")
127 ...I PXQWORD("TYPE")["WORD-PROCESSING" D
128 ....K PXQWORD,^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD)
129 ....S ^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD,"E")="(word-processing field)"
130 ...S PXQX=$G(^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD,"E"))
131 ...I PXQX["""" S PXQX="(not displayable-look up entry)"
132 ...S ^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD,"E")=PXQX
133 ...;---END OF CODE
134 ...N PXQNF,PXQMOV
135 ...S PXQMOV=""",?35,"""
136 ...S PXQNF=$P($G(@DD@(PXQFILE,PXQFIELD,0)),"^",1)_PXQMOV_" = "_$G(^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD,"E"))
137 ...W $$RE^PXQUTL(""_"?"_PXQLIEN_","_""""_PXQNF_"""")
138 W $$RE^PXQUTL("______________________________________________________________")
139 Q
140 ;
141ADD ;--GET FIELD VALUES FOR FILE
142 I $D(^TMP("PXQADDITIONAL",$J,FILE)) D
143 .S PXQNFLD=0 F S PXQNFLD=$O(^TMP("PXQADDITIONAL",$J,FILE,PXQNFLD)) Q:PXQNFLD="" D
144 ..I $G(PXQIENS) D GETS^DIQ(FILE,PXQIENS,PXQNFLD,"E","^TMP(""PXQDATA"",$J,")
145 Q
146 ;
147ADD1 ;--GET FIELD VALUES FOR UPFILE
148 I $D(^TMP("PXQADDITIONAL",$J,UPFILE)) D
149 .S PXQNFLD=0 F S PXQNFLD=$O(^TMP("PXQADDITIONAL",$J,UPFILE,PXQNFLD)) Q:PXQNFLD="" D
150 ..I $G(PXQIENS) D GETS^DIQ(UPFILE,PXQIENS,PXQNFLD,"E","^TMP(""PXQDATA"",$J,")
151 Q
152 ;
153ADD2 ;--ADDITIONAL FIELDS IN A FILE TO BE DIAPLAYED
154 ;--LOCATE DUZ ENTRY
155 ; VARIABLES:
156 ; PXQUSER = Entry in file #812 representing the DUZ
157 ; PXQFLE = File Number
158 ; PXQFLEIE= File Number IEN in file #812
159 ; PXQFLD = The Field in the above file
160 ;
161 N PXQUSER,PXQFLE,PXQFLEIE,PXQFLD
162 S PXQUSER=$O(^PXD(812,"B",DUZ,0)) I PXQUSER="" Q
163 ;--LOCATE FILE NUMBERS
164 S PXQFLE=0 F S PXQFLE=$O(^PXD(812,PXQUSER,"FILE","B",PXQFLE)) Q:PXQFLE="" D
165 .S PXQFLEIE=0 F S PXQFLEIE=$O(^PXD(812,PXQUSER,"FILE","B",PXQFLE,PXQFLEIE)) Q:PXQFLEIE="" D
166 ..S PXQFLD=0 F S PXQFLD=$O(^PXD(812,PXQUSER,"FILE",PXQFLEIE,"FIELD","B",PXQFLD)) Q:PXQFLD="" D
167 ...S ^TMP("PXQADDITIONAL",$J,PXQFLE,PXQFLD)=""
168 ;
169MUST ;--MUST ADDITIONAL ENTRIES TO MAKE SENSE
170 S ^TMP("PXQADDITIONAL",$J,9000010.18,.16)="" ;-QUANTITY -V CPT
171 S ^TMP("PXQADDITIONAL",$J,409.51,21)="" ;-CPT CODES - SCHEDULING VISITS
172 S ^TMP("PXQADDITIONAL",$J,409.51,22)="" ; " "
173 S ^TMP("PXQADDITIONAL",$J,409.51,23)="" ; " "
174 S ^TMP("PXQADDITIONAL",$J,409.51,24)="" ; " "
175 S ^TMP("PXQADDITIONAL",$J,409.51,25)="" ; " "
176 S ^TMP("PXQADDITIONAL",$J,409.68,.04)="" ;-LOCATION - ENCOUNTER
177 S ^TMP("PXQADDITIONAL",$J,409.68,.08)="" ;-ORIGINATING - ENCOUNTER
178 S ^TMP("PXQADDITIONAL",$J,9000010,.22)="" ;-VISIT - LOCATION
179 S ^TMP("PXQADDITIONAL",$J,9000010,.05)="" ;-VISIT - PATIENT
180 S ^TMP("PXQADDITIONAL",$J,70.02,3)="" ;-REGISTERED EXAMS - DIVISION
181 S ^TMP("PXQADDITIONAL",$J,70.02,4)="" ;-REGISTERED EXAMS - LOCATION
182 S ^TMP("PXQADDITIONAL",$J,70.02,5)="" ;-REGISTERED EXAMS - EXAM SET
183 S ^TMP("PXQADDITIONAL",$J,70.03,2)="" ;-EXAMINATIONS - PROCEDURE
184 S ^TMP("PXQADDITIONAL",$J,70.03,3)="" ;-EXAMINATIONS - EXAM STATUS
185 S ^TMP("PXQADDITIONAL",$J,70.03,4)="" ;-EXAMINATIONS - CATEGORY
186 S ^TMP("PXQADDITIONAL",$J,70.03,23)="" ;-EXAMINATIONS - CLINIC STOP REC
187 S ^TMP("PXQADDITIONAL",$J,70.03,26)="" ;-EXAMINATIONS - CREDIT METHOD
188 ;
189 ;S ^TMP("PXQADDITIONAL",$J,8925,.02)="" ;-TIU FIELDS
190 ;S ^TMP("PXQADDITIONAL",$J,8925,.03)="" ;-TIU FIELDS
191 ;S ^TMP("PXQADDITIONAL",$J,8925,.04)="" ;-TIU FIELDS
192 ;S ^TMP("PXQADDITIONAL",$J,8925,.05)="" ;-TIU FIELDS
193 ;S ^TMP("PXQADDITIONAL",$J,8925,.07)="" ;-TIU FIELDS
194 ;S ^TMP("PXQADDITIONAL",$J,8925,.1)="" ;-TIU FIELDS
195 ;S ^TMP("PXQADDITIONAL",$J,8925,1201)="" ;-TIU FIELDS
196 ;S ^TMP("PXQADDITIONAL",$J,8925,1202)="" ;-TIU FIELDS
197 ;S ^TMP("PXQADDITIONAL",$J,8925,1204)="" ;-TIU FIELDS
198 ;S ^TMP("PXQADDITIONAL",$J,8925,1205)="" ;-TIU FIELDS
199 ;S ^TMP("PXQADDITIONAL",$J,8925,1301)="" ;-TIU FIELDS
200 ;S ^TMP("PXQADDITIONAL",$J,8925,1302)="" ;-TIU FIELDS
201 ;S ^TMP("PXQADDITIONAL",$J,8925,1404)="" ;-TIU FIELDS
202 ;S ^TMP("PXQADDITIONAL",$J,8925,1502)="" ;-TIU FIELDS
203 ;S ^TMP("PXQADDITIONAL",$J,8925,1503)="" ;-TIU FIELDS
204 ;S ^TMP("PXQADDITIONAL",$J,8925,1504)="" ;-TIU FIELDS
205 ;S ^TMP("PXQADDITIONAL",$J,8925,1505)="" ;-TIU FIELDS
206 Q
Note: See TracBrowser for help on using the repository browser.