source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF18E1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1IBDF18E1 ;ALB/CJM - ENCOUNTER FORM - PCE DEVICE INTERFACE utilities ;04-OCT-94
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**1,3,38,36**;APR 24, 1997
3 ;
4GETPI(PI,QLFR,TYPE) ; -- returns information about the package interface
5 ; needed to map data to PCE DEVICE INTERFACE
6 ;
7 ; -- input - PI := pointer to the package interface file
8 ; MUST be passed by reference
9 ; QLFR := pointer to the data qualifier
10 ; TYPE := pointer to file 359.1, applies to hand print fields
11 ;
12 ; -- output PI :="" if the mapping can not be determined
13 ; PI(PI,"NODE")
14 ; PI(PI,"VAL")
15 ; PI(PI,"TXT")
16 ; PI(PI,"HDR")
17 ; PI(PI,"QLFR")
18 ; PI(PI,"QTY")
19 ; - if QLFR is passed, also returns PI(PI,QLFR,"IND")
20 ; - if PI(PI,QLFR,"IND")=1,meaning there is independent mapping
21 ; info for this qualifier - then also returns PI(PI,QLFR,"NODE")=
22 ; <the node>,PI(PI,QLFR,"VAL")=<piece for the value>,
23 ; PI(PI,QLFR,"TXT")=<the piece for txt>,PI(PI,QLFR,"HDR")=
24 ; <piece for the hdr>,
25 ; PI(PI,QLFR,"QLFR")=<piece for the qualifier code>
26 ; - if TYPE is passed , also returns PI(PI,"TYPE",TYPE,"UNIT")=
27 ; <unit code> and PI(PI,"TYPE",TYPE,"VTYPE")=
28 ; <vitals type code>
29 ;
30 ;NOTE - it is assumed that entries in the PI() may be left hanging around,and if so they are valid
31 ;
32 N NODE,QNODE,PIECE,IEN
33 I '$G(PI) S PI="" G GETPIQ
34 ;
35 ; -- type of package interface must be for input
36 I $P($G(^IBE(357.6,PI,0)),"^",6)'=1 S PI="" G GETPIQ
37 ;
38 I '$D(PI(PI)) D Q:'PI ""
39 .S NODE=$G(^IBE(357.6,PI,12))
40 .S PI(PI,"NODE")=$P(NODE,"^")
41 .S PI(PI,"VAL")=$P(NODE,"^",2)
42 .S PI(PI,"TXT")=$P(NODE,"^",3)
43 .S PI(PI,"HDR")=$P(NODE,"^",4)
44 .S PI(PI,"QLFR")=$P(NODE,"^",5)
45 .S PI(PI,"QTY")=$P(NODE,"^",6)
46 ;
47 ; - if there is a 'PCE DIM PIECE, VARIABLE VALUE' node, execute code to
48 ; - determine value for PCE DIM PIECE, VALUE (since it is variable, it
49 ; - must be asked outside of the above dotted do
50 S X="",Y=VALUE X $G(^IBE(357.6,PI,21)) I X S PI(PI,"VAL")=X
51 ;
52 ;special rules apply for the VITALS node
53 I PI(PI,"NODE")="VITALS" D Q:'PI ""
54 .S PI(PI,"VAL")=2 ;the value for the VITALS node goes to piece 2
55 .;
56 .I 'TYPE D LOGERR^IBDF18E2(35791001,.FORMID,TYPE,$G(VALUE),PI) S PI(PI,"TYPE",+$G(TYPE),"VTYPE")="",PI(PI,"TYPE",+$G(TYPE),"UNIT")="" Q
57 .;
58 .;may have already gotten
59 .I $D(PI(PI,"TYPE",TYPE)) Q
60 .;
61 .S IEN=$O(^IBE(357.6,PI,13,"B",TYPE_";IBE(359.1,",""))
62 .I 'IEN D LOGERR^IBDF18E2(3576001,.FORMID,TYPE,$G(VALUE),PI) S PI(PI,"TYPE",TYPE,"VTYPE")="",PI(PI,"TYPE",TYPE,"UNIT")="" Q
63 .S NODE=$G(^IBE(359.1,TYPE,0))
64 .S PI(PI,"TYPE",TYPE,"UNIT")=$P(NODE,"^",13)
65 .S PI(PI,"TYPE",TYPE,"VTYPE")=$P(NODE,"^",12)
66 .S PI(PI,"TYPE",TYPE,"DATATYPE")=$P($G(^IBE(359.1,TYPE,10)),"^",1)
67 ;
68 ;if not VITALS, and there is a QLFR, get independent mapping info if not gotten previously
69 I PI(PI,"NODE")'="VITALS",QLFR I '$D(PI(PI,QLFR,"IND")) D Q:'PI ""
70 .S PI(PI,QLFR,"CODE")=$P($G(^IBD(357.98,QLFR,0)),"^",2)
71 .S IEN=$O(^IBE(357.6,PI,13,"B",QLFR_";IBD(357.98,",""))
72 .I 'IEN D LOGERR^IBDF18E2(3576002,.FORMID,$G(TYPE),$G(VALUE),PI,$G(QLFR)) S PI(PI,QLFR,"IND")=0 Q
73 .S NODE=$G(^IBE(357.6,PI,13,IEN,0))
74 .S PI(PI,QLFR,"IND")=$P(NODE,"^",3)
75 .Q:'PI(PI,QLFR,"IND")
76 .S QNODE=$P(NODE,"^",4) S:QNODE="" QNODE=PI(PI,"NODE") S PI(PI,QLFR,"NODE")=QNODE
77 .S PIECE=$P(NODE,"^",8) S:('PIECE)&(PI(PI,"NODE")=PI(PI,QLFR,"NODE")) PIECE=PI(PI,"QLFR") S PI(PI,QLFR,"QLFR")=PIECE
78 .;
79 .;if the node isn't different for the qualifier then the value,text,and header can not be mapped independently
80 .I PI(PI,"NODE")=PI(PI,QLFR,"NODE") D
81 ..S PI(PI,QLFR,"VAL")=PI(PI,"VAL"),PI(PI,QLFR,"TXT")=PI(PI,"TXT"),PI(PI,QLFR,"HDR")=PI(PI,"HDR")
82 .E S PI(PI,QLFR,"VAL")=$P(NODE,"^",5),PI(PI,QLFR,"TXT")=$P(NODE,"^",6),PI(PI,QLFR,"HDR")=$P(NODE,"^",7)
83 .;must at least know the piece to place the returned value
84 .I (PI(PI,QLFR,"NODE")="")!('PI(PI,QLFR,"VAL")) S PI=""
85 ;
86 ;must at least know the node and the piece to place the returned value
87 I 'QLFR I (PI(PI,"NODE")="")!('PI(PI,"VAL")) S PI=""
88GETPIQ Q PI
89 ;
90SETTEMP ; -- sets values for the field into TEMP()
91 ; values are merged for fields that consist of a collection
92 ;
93 ; -- Output QCODE := <qualifier code>
94 ; PHDR := <header piece>
95 ; PVAL := <value piece>
96 ; PTXT := <text piece>
97 ; PQLFR := <qualifier piece>
98 ; SUB := <PCE GDI node>
99 ; NODE := <the value of the node>
100 ; PLEX := <clinical lexicon piece, for use with diag.>
101 ;
102 N QCODE,PHDR,PVAL,PTXT,PQLFR,SUB,NODE,PLEX,PQTY,SAVEPI
103 S SAVEPI=PI
104 Q:'PI
105 S PI=$$GETPI(.PI,QLFR,TYPE) I 'PI D LOGERR^IBDF18E2(3576003,.FORMID,$G(TYPE),$G(VALUE),SAVEPI,$G(QLFR)) Q
106 ;
107 S QCODE=$S(QLFR:PI(PI,QLFR,"CODE"),1:"")
108 ;
109 ;determine if QCODE should be passed as VALUE
110 I $P($G(^IBE(357.6,PI,20)),"^") N VALUE S VALUE=QCODE
111 ;
112 S PQTY=PI(PI,"QTY")
113 ;mapping info could come from several different sources depending on whether or not a data qualifier is involved or the node=VITALS or ENCOUNTER
114 I QLFR,PI(PI,"NODE")'="VITALS",PI(PI,"NODE")'="ENCOUNTER" I PI(PI,QLFR,"IND") D
115 .S PHDR=PI(PI,QLFR,"HDR"),PVAL=PI(PI,QLFR,"VAL"),PTXT=PI(PI,QLFR,"TXT"),PQLFR=PI(PI,QLFR,"QLFR"),SUB=PI(PI,QLFR,"NODE")
116 E D
117 .S PHDR=PI(PI,"HDR"),PVAL=PI(PI,"VAL"),PTXT=PI(PI,"TXT"),PQLFR=PI(PI,"QLFR"),SUB=PI(PI,"NODE")
118 ;
119 ;the ENCOUNTER node is treated differently, because there is always just one of them
120 S:SUB'="ENCOUNTER" NODE=$G(TEMP(SUB,$P(FID,"("),+ITEM))
121 S:SUB="ENCOUNTER" NODE=$G(PXCA("ENCOUNTER"))
122 ;
123 ; -- define clin lex pointer if from data enty ($d(ibdf(item)))
124 ; if from scanning clin lex pointer defined in ibdf18e
125 S PLEX=0 I SUB="DIAGNOSIS/PROBLEM" D
126 .S PLEX=3
127 .I $G(ITEM)'="" I $D(IBDF(ITEM)) S LEX=$P(IBDF(ITEM),"^",5)
128 ;
129 ;the VITALS node is also treated differently
130 I SUB="VITALS" D
131 .I $G(PI(PI,"TYPE",TYPE,"DATATYPE"))="f" S VALUE=+VALUE ; set floating point values to M values
132 .S $P(NODE,"^")=PI(PI,"TYPE",TYPE,"VTYPE"),$P(NODE,"^",3)=PI(PI,"TYPE",TYPE,"UNIT"),$P(NODE,"^",2)=VALUE,$P(NODE,"^",4)=+$G(PXCA("ENCOUNTER"))
133 ;these are nodes other than VITALS and ENCOUNTER
134 E D
135 .;merge the data into the node
136 .;
137 .; -- for second provider entry put in provider node, always put
138 .; primary in encounter node
139 .I SUB="ENCOUNTER",PVAL=4,$P(NODE,"^",4) D Q
140 ..I QCODE="P",$P(NODE,"^",15)'="P" S PXCA("PROVIDER",$P(NODE,"^",4))=$P(NODE,"^",15),$P(NODE,"^",4)=VALUE,$P(NODE,"^",15)=QCODE Q
141 ..S PXCA("PROVIDER",VALUE)=QCODE Q
142 .;
143 .S NARR=+$G(NARR) ; define Narr for manual data entry
144 .;
145 .; -- change to add modifiers to visit code selected
146 .;
147 .I $P(NODE,"^",PVAL)="" D
148 .. S:$S(NARR=0:1,1:$P(FID,"(",2)'="N") $P(NODE,"^",PVAL)=VALUE
149 .. ;D MODTEMP
150 .I PTXT S:$P(FID,"(",2)="N"&NARR TEXT=VALUE I $S(NARR=0:$L($P(NODE,"^",PTXT))<$L(TEXT),$P(FID,"(",2)="N":TEXT'="",1:0) S $P(NODE,"^",PTXT)=TEXT
151 .I PHDR I $L($P(NODE,"^",PHDR))<$L(HEADER) S $P(NODE,"^",PHDR)=HEADER
152 .I PQTY S $P(NODE,"^",PQTY)=$G(QUANTITY)
153 .;
154 .; -- insert clin lex pointer into temp arry and re-initialize
155 .I $G(PLEX),$G(LEX) S $P(NODE,"^",PLEX)=LEX
156 .S LEX=0
157 .;
158 .I QCODE'="" S $P(NODE,"^",PQLFR)=$S($P(NODE,"^",PQLFR)'="":$P(NODE,"^",PQLFR)_","_QCODE,1:QCODE)
159 ;
160 ;- Prevent 'No classification' node from being set in TEMP array
161 ;- (not dynamic)
162 S:SUB'="ENCOUNTER"&(SUB'="IBD NOCLASSIFICATION") TEMP(SUB,$P(FID,"("),+ITEM)=NODE
163 D:SUB="PROCEDURE" MODTEMP
164 ;
165 ;- Set Encounter and 'No classification' nodes into PXCA array
166 S:SUB="ENCOUNTER"!(SUB="IBD NOCLASSIFICATION") PXCA(SUB)=NODE
167 D:SUB="ENCOUNTER" MODTEMP
168 Q
169MODTEMP ;-- Set up TEMP(SUB,$P(FID,"("),+ITEM, "MODIFIER array
170 ; the CPT Modifier information is stored in the selection file(357.3)
171 ;
172 ;
173 N MCOUNT,MOD
174 I $D(^IBE(357.3,+$G(SLCTN),3)) D
175 . S MCOUNT=0
176 . F MOD=0:0 S MOD=$O(^IBE(357.3,SLCTN,3,MOD)) Q:'MOD D
177 .. S MCOUNT=MCOUNT+1
178 ..S TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",MCOUNT)=$P($G(^IBE(357.3,SLCTN,3,MOD,0)),"^")
179 .S:MCOUNT>0 TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",0)=MCOUNT
180 I $D(IBDF(+ITEM,"MODIFIER")) D
181 . S MCOUNT=+$G(TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",0))
182 . S MOD=0 F S MOD=$O(IBDF(+ITEM,"MODIFIER",MOD)) Q:'MOD D
183 .. S MCOUNT=MCOUNT+1
184 .. S TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",MCOUNT)=IBDF(+ITEM,"MODIFIER",MOD)
185 . S TEMP(SUB,$P(FID,"("),+ITEM,"MODIFIER",0)=MCOUNT
186 Q
Note: See TracBrowser for help on using the repository browser.