source: FOIAVistA/tag/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF18E.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1IBDF18E ;ALB/CJM - ENCOUNTER FORM - PCE DEVICE INTERFACE utilities ;04-OCT-94
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**3,25,38,37**;APR 24, 1997
3 ;
4SEND(FORMID,PROVIDER,PROVTYPE,BUBBLES,HANDPRNT,CHECKOUT,PXCA,DYNAMIC) ;builds the PCXA array and passes it to PCE, updates form tracking status
5 ;input:
6 ; FORMID = the unique id assigned to the printed form, points to the FORM TRACKING file
7 ; PROVIDER=pointer to NEW PERSON file (#200) (optional)
8 ; PROVTYPE= P:=primary,S:=secondary (optional)
9 ; BUBBLES = an array which should be passed by reference, BUBBLES is the list of bubbles marked on the form, subscripted by pointers to the BUBBLES multiple in the FORM DEFINITION TABLE
10 ; HANDPRNT is the list of hand print fields marked on the form - subscripted by pointers to the HAND PRINT FIELDS multiple in the FORM DEFINITION TABLE, the value being what was input (HANDPRINT(<ien>)=<value>) - should be passed by reference
11 ; CHECKOUT = checkout data@time
12 ; DYNAMIC = an array which should be passed by reference, contains the list of bubbles selected from dynamic selection lists
13 ;
14 ;output:
15 ; = 0 if the data is not passed to PCE
16 ; = 1 if PXCA is passed by reference, and the data is passed to PCE
17 ; the PXCA array is returned, principally to aid in debugging
18 ;
19 ;example: S RETURN=$$SEND^IBDF18E(3,DOCTOR,"P",.BUBBLES,.HANDPRNT)
20 ;
21 N D,D0,NODE,FORMTYPE,PXCASTAT,IBAPPT,IBCLINIC,IBDFN,VALUE,VALUE1,PI,TEXT,HEADER,QLFR,BUB,STATUS,IBSOURCE,HAND,COUNT,FID,FNM,TEMP,ITEM,TYPE,IBDF,LEX,PLEX,QUANTITY,NARR,SLCTN
22 ;
23 S FORMID("WSID")=$G(^TMP("IBD-SCAN-RAWDATA",$J,"WSID"))
24 S FORMID("PAGE")=+$P($G(^TMP("IBD-SCAN-RAWDATA",$J,"FD1")),"PAGE=",2)
25 K PXCA
26 S (PXCA,PXCASTAT)=""
27 ;
28 ;check that the required parameters were passed
29 I '$G(FORMID) D LOGERR^IBDF18E2(3579601,.FORMID) Q 0
30 ;
31 ;there must be an entry in form tracking - retrieve it into FORMID array
32 I '$$TRACKING^IBDF18E0(.FORMID) D LOGERR^IBDF18E2(3579501,.FORMID) Q 0
33 ;
34 ;there must be a form definition table
35 S FORMTYPE=$P(NODE,"^",4)
36 I 'FORMTYPE S STATUS=$$FSCND^IBDF18C(FORMID,12) Q 0
37 I '$G(^IBD(357.95,FORMTYPE,0)) S STATUS=$$FSCND^IBDF18C(FORMID,12) Q 0
38 ;
39 S PROVIDER=$G(PROVIDER)
40 S PROVTYPE=$G(PROVTYPE)
41 ;
42 ;build the encounter node and source node from form tracking
43 S PXCA("ENCOUNTER")=FORMID("APPT")_"^"_FORMID("DFN")_"^"_FORMID("CLINIC")_"^"_PROVIDER_"^^^^^^^^^^"_CHECKOUT_"^"_PROVTYPE
44 S PXCA("SOURCE")=+FORMID("SOURCE")_"^"_DUZ_"^"_FORMTYPE_"^^"_FORMID
45 ;
46 ;now for each bubble in BUBBLES() add to TEMP()
47 S BUB=0 F S BUB=$O(BUBBLES(BUB)) Q:BUB="" S:BUB NODE=$G(^IBD(357.95,FORMTYPE,1,BUB,0)) D
48 .N SUBHDR
49 .I 'BUB!(NODE="") D LOGERR^IBDF18E2(3579502,.FORMID,BUB,BUBBLES(BUB)) Q
50 .S $P(NODE,"^",8)=$S($D(^IBD(357.95,FORMTYPE,1,BUB,2))&($P($G(^IBD(357.95,FORMTYPE,1,BUB,2)),"^",1)]""):$P($G(^IBD(357.95,FORMTYPE,1,BUB,2)),"^",1),1:$P(NODE,"^",8))
51 .S VALUE=$P(NODE,"^",4)
52 .S PI=$P(NODE,"^",3)
53 .S TEXT=$P(NODE,"^",8)
54 .S FNM=$P(NODE,"^",5)
55 .; -- strip :: code from TEXT if it exists
56 .I TEXT[" :: " S TEXT=$$DISP^IBDFM1(TEXT)
57 .;I TEXT[" :: ",PI,VALUE D
58 .;.S (Y,X)=VALUE X $G(^IBE(357.6,PI,14)) I Y]"" S TEXT=$P(TEXT," :: "_Y)
59 .S SUBHDR=$G(^IBD(357.95,FORMTYPE,1,BUB,1))
60 .;
61 .; -- the following line causes the subheader and display text to
62 .; to be concatenated except for IB, which can pass an alternate
63 .; text. (some don't like this when passed to Problem List)
64 .; This may need to be re-visited in the future
65 .I +FORMID("SOURCE")'=1,$L(SUBHDR),($L(SUBHDR)+$L(TEXT)<80) S TEXT=SUBHDR_" "_TEXT
66 .S HEADER=$P(NODE,"^",9)
67 .S FID=$P(NODE,"^",6) I FID="" S FID=$P(NODE,"^") ;PANDAS uses piece 1 to number each bubble - does not use piece 6
68 .S ITEM=$P(NODE,"^",12)
69 .S QLFR=$P(NODE,"^",10)
70 .S QUANTITY=$P(NODE,"^",13)
71 .S SLCTN=$P(NODE,"^",14) ;--added for modifiers, pointer to file 357.3
72 .;
73 .; -- if text contains 'x #' for quantity, strip it
74 .;I +QUANTITY I TEXT[(" x "_QUANTITY) S TEXT=$TR(TEXT," x "_QUANTITY)
75 .I +QUANTITY I TEXT[(" x "_QUANTITY) D
76 ..S X=" x "_QUANTITY
77 ..S TEXT=$E(TEXT,1,$F(TEXT,X)-($L(X)+1))_$E(TEXT,$F(TEXT,X),$L(TEXT))
78 .;
79 .S TYPE="",(LEX,NARR)=0
80 .I $D(^IBD(357.95,FORMTYPE,1,BUB,2)) S LEX=$P($G(^IBD(357.95,FORMTYPE,1,BUB,2)),"^",2)
81 .D SETTEMP^IBDF18E1
82 .D CODES^IBDF18E0
83 K BUBBLES
84 ;
85 ;now for each bubble in DYNAMIC() add to TEMP()
86 S FID="" F S FID=$O(DYNAMIC(FID)) Q:FID="" S COUNT="" F S COUNT=$O(DYNAMIC(FID,COUNT)) Q:COUNT="" S BUB=$O(^IBD(357.96,FORMID,"AC",FID,+COUNT,0)) S:BUB NODE=$G(^IBD(357.96,FORMID,1,BUB,0)) D
87 .I 'BUB!(NODE="") D LOGERR^IBDF18E2(3579602,.FORMID,FID,DYNAMIC(FID,COUNT)) Q
88 .S VALUE=$P(NODE,"^",4)
89 .S PI=$P(NODE,"^",3)
90 .S TEXT=$P(NODE,"^",8)
91 .; -- strip :: code from TEXT if it exists
92 .I TEXT[" :: " S TEXT=$$DISP^IBDFM1(TEXT)
93 .;I TEXT[" :: " S TEXT=$P(TEXT," :: ")
94 .S HEADER=""
95 .S FID=$P(NODE,"^",6)
96 .S ITEM=$P(NODE,"^")
97 .S QLFR=$P(NODE,"^",10)
98 .S TYPE=""
99 .S LEX=0
100 .S SLCTN=$P(NODE,"^",14) ;--added for modifiers, pointer fo file 357.3
101 .D SETTEMP^IBDF18E1
102 K DYNAMIC
103 ;
104 ;now for each hand print field in HANDPRNT() add to TEMP()
105 ;
106 S HAND=0 F S HAND=$O(HANDPRNT(HAND)) Q:HAND="" S:HAND NODE=$G(^IBD(357.95,FORMTYPE,2,HAND,0)) D
107 .I 'HAND!(NODE="") D LOGERR^IBDF18E2(3579503,.FORMID,HAND,HANDPRNT(HAND)) Q
108 .S TYPE=$P(NODE,"^",17)
109 .S VALUE=HANDPRNT(HAND) S:$E(VALUE,$L(VALUE))="," VALUE=$E(VALUE,1,$L(VALUE)-1)
110 .;
111 .;what was printed may need transformation/formating
112 .S VALUE1=VALUE,VALUE=$$HPTRNS^IBDFU91(TYPE,VALUE,.FORMID)
113 .;
114 .; -- failed the input transform
115 .I VALUE="" D LOGERR^IBDF18E2(3579504,.FORMID,HAND,VALUE1,"","",TYPE) Q
116 .;
117 .S PI=$P(NODE,"^",4)
118 .S TEXT=$P(NODE,"^",7)
119 .S HEADER=$P(NODE,"^",9)
120 .S FID=$P(NODE,"^",8)
121 .S ITEM=$P(NODE,"^",12)
122 .S QLFR=$P(NODE,"^",10)
123 .S (LEX,NARR)=0
124 .S SLCTN=$P(NODE,"^",14) ;--added for modifiers, pointer to file 357.3
125 .I $P($G(^IBE(357.2,+$E(FID,2,$L(FID)),0)),U,18)=3 S NARR=1 ;Send both code and narrative
126 .D SETTEMP^IBDF18E1
127 K HANDPRNT
128 ;
129 ; --added to copy visit modifiers if any
130 ;
131 D:$D(TEMP("ENCOUNTER")) VSTPXCA^IBDF18E0
132 ;
133 D SETPXCA^IBDF18E0,PRO^IBDF18E0,SC^IBDF18E0
134 ;
135 ; -- do misc. passing to other packages that do not use PCE
136 ;
137 D ^IBDF18E4
138 ;
139 ;
140 I $D(PXCA("IBD-ABORT")) D S PXCASTAT=0 G SENDQ
141 .S I="" F S I=$O(PXCA("IBD-ABORT",I)) Q:I="" S J="" F S J=$O(PXCA("IBD-ABORT",I,J)) Q:J="" D
142 ..I +PXCA("IBD-ABORT",I,J)=3 K PXCA("IBD-ABORT",I,J) Q
143 ..D LOGERR^IBDF18E2(3570004,.FORMID,"",$P(PXCA("IBD-ABORT",I,J),"^",2))
144 ;
145 I +FORMID("SOURCE")=1 D QUE^IBDF18E3 G STAT
146 ;
147 S IBD("AICS")=1 ;flag for IBDF PCE EVENT protocol
148 S IBD("PASSFLAG")=+$P($G(^IBD(357.09,1,0)),"^",7)
149 I $G(IBD("PASSFLAG"))<2 D VALIDATE^PXCA(.PXCA) I '$D(PXCA("ERROR")) D BACKGND^PXCA(.PXCA,.PXCASTAT)
150 I $G(IBD("PASSFLAG"))>1 D FOREGND^PXCA(.PXCA,.PXCASTAT)
151 K IBD("AICS"),IBD("PASSFLAG")
152 ;
153STAT S STATUS=$$FSCND^IBDF18C(FORMID,$S(PXCASTAT=0:4,PXCASTAT=1:3,1:12),$S(PXCASTAT=0:"PCE RETURNED AN ERROR",1:""))
154 ;
155 ; -- kill erroneous inpatient warnings
156 I $D(PXCA("WARNING","ENCOUNTER"))>0 D INPT^IBDF18E0($G(FORMID("DFN")),$G(FORMID("APPT")))
157 ;
158 ; -- log pce errors and warnings in AICS Error file
159 I $O(PXCA("ERROR",""))'=""!($O(PXCA("WARNING",""))'="") S FORMID("SOURCE")=99 D LOGERR^IBDF18E2(3570001,.FORMID)
160 ;
161 ; -- if pce returns an error unflag all pages as received and delete
162 ; all scanned data so data can be re-scanned
163SENDQ I $O(PXCA("ERROR",""))'=""!($O(PXCA("IBD-ABORT",""))'="") D UNRECV^IBDFBK2(FORMID)
164 Q +$G(PXCASTAT)
Note: See TracBrowser for help on using the repository browser.