165 lines
7.2 KiB
Mathematica
165 lines
7.2 KiB
Mathematica
IBDF18E ;ALB/CJM - ENCOUNTER FORM - PCE DEVICE INTERFACE utilities ;04-OCT-94
|
|
;;3.0;AUTOMATED INFO COLLECTION SYS;**3,25,38,37**;APR 24, 1997
|
|
;
|
|
SEND(FORMID,PROVIDER,PROVTYPE,BUBBLES,HANDPRNT,CHECKOUT,PXCA,DYNAMIC) ;builds the PCXA array and passes it to PCE, updates form tracking status
|
|
;input:
|
|
; FORMID = the unique id assigned to the printed form, points to the FORM TRACKING file
|
|
; PROVIDER=pointer to NEW PERSON file (#200) (optional)
|
|
; PROVTYPE= P:=primary,S:=secondary (optional)
|
|
; 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
|
|
; 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
|
|
; CHECKOUT = checkout data@time
|
|
; DYNAMIC = an array which should be passed by reference, contains the list of bubbles selected from dynamic selection lists
|
|
;
|
|
;output:
|
|
; = 0 if the data is not passed to PCE
|
|
; = 1 if PXCA is passed by reference, and the data is passed to PCE
|
|
; the PXCA array is returned, principally to aid in debugging
|
|
;
|
|
;example: S RETURN=$$SEND^IBDF18E(3,DOCTOR,"P",.BUBBLES,.HANDPRNT)
|
|
;
|
|
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
|
|
;
|
|
S FORMID("WSID")=$G(^TMP("IBD-SCAN-RAWDATA",$J,"WSID"))
|
|
S FORMID("PAGE")=+$P($G(^TMP("IBD-SCAN-RAWDATA",$J,"FD1")),"PAGE=",2)
|
|
K PXCA
|
|
S (PXCA,PXCASTAT)=""
|
|
;
|
|
;check that the required parameters were passed
|
|
I '$G(FORMID) D LOGERR^IBDF18E2(3579601,.FORMID) Q 0
|
|
;
|
|
;there must be an entry in form tracking - retrieve it into FORMID array
|
|
I '$$TRACKING^IBDF18E0(.FORMID) D LOGERR^IBDF18E2(3579501,.FORMID) Q 0
|
|
;
|
|
;there must be a form definition table
|
|
S FORMTYPE=$P(NODE,"^",4)
|
|
I 'FORMTYPE S STATUS=$$FSCND^IBDF18C(FORMID,12) Q 0
|
|
I '$G(^IBD(357.95,FORMTYPE,0)) S STATUS=$$FSCND^IBDF18C(FORMID,12) Q 0
|
|
;
|
|
S PROVIDER=$G(PROVIDER)
|
|
S PROVTYPE=$G(PROVTYPE)
|
|
;
|
|
;build the encounter node and source node from form tracking
|
|
S PXCA("ENCOUNTER")=FORMID("APPT")_"^"_FORMID("DFN")_"^"_FORMID("CLINIC")_"^"_PROVIDER_"^^^^^^^^^^"_CHECKOUT_"^"_PROVTYPE
|
|
S PXCA("SOURCE")=+FORMID("SOURCE")_"^"_DUZ_"^"_FORMTYPE_"^^"_FORMID
|
|
;
|
|
;now for each bubble in BUBBLES() add to TEMP()
|
|
S BUB=0 F S BUB=$O(BUBBLES(BUB)) Q:BUB="" S:BUB NODE=$G(^IBD(357.95,FORMTYPE,1,BUB,0)) D
|
|
.N SUBHDR
|
|
.I 'BUB!(NODE="") D LOGERR^IBDF18E2(3579502,.FORMID,BUB,BUBBLES(BUB)) Q
|
|
.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))
|
|
.S VALUE=$P(NODE,"^",4)
|
|
.S PI=$P(NODE,"^",3)
|
|
.S TEXT=$P(NODE,"^",8)
|
|
.S FNM=$P(NODE,"^",5)
|
|
.; -- strip :: code from TEXT if it exists
|
|
.I TEXT[" :: " S TEXT=$$DISP^IBDFM1(TEXT)
|
|
.;I TEXT[" :: ",PI,VALUE D
|
|
.;.S (Y,X)=VALUE X $G(^IBE(357.6,PI,14)) I Y]"" S TEXT=$P(TEXT," :: "_Y)
|
|
.S SUBHDR=$G(^IBD(357.95,FORMTYPE,1,BUB,1))
|
|
.;
|
|
.; -- the following line causes the subheader and display text to
|
|
.; to be concatenated except for IB, which can pass an alternate
|
|
.; text. (some don't like this when passed to Problem List)
|
|
.; This may need to be re-visited in the future
|
|
.I +FORMID("SOURCE")'=1,$L(SUBHDR),($L(SUBHDR)+$L(TEXT)<80) S TEXT=SUBHDR_" "_TEXT
|
|
.S HEADER=$P(NODE,"^",9)
|
|
.S FID=$P(NODE,"^",6) I FID="" S FID=$P(NODE,"^") ;PANDAS uses piece 1 to number each bubble - does not use piece 6
|
|
.S ITEM=$P(NODE,"^",12)
|
|
.S QLFR=$P(NODE,"^",10)
|
|
.S QUANTITY=$P(NODE,"^",13)
|
|
.S SLCTN=$P(NODE,"^",14) ;--added for modifiers, pointer to file 357.3
|
|
.;
|
|
.; -- if text contains 'x #' for quantity, strip it
|
|
.;I +QUANTITY I TEXT[(" x "_QUANTITY) S TEXT=$TR(TEXT," x "_QUANTITY)
|
|
.I +QUANTITY I TEXT[(" x "_QUANTITY) D
|
|
..S X=" x "_QUANTITY
|
|
..S TEXT=$E(TEXT,1,$F(TEXT,X)-($L(X)+1))_$E(TEXT,$F(TEXT,X),$L(TEXT))
|
|
.;
|
|
.S TYPE="",(LEX,NARR)=0
|
|
.I $D(^IBD(357.95,FORMTYPE,1,BUB,2)) S LEX=$P($G(^IBD(357.95,FORMTYPE,1,BUB,2)),"^",2)
|
|
.D SETTEMP^IBDF18E1
|
|
.D CODES^IBDF18E0
|
|
K BUBBLES
|
|
;
|
|
;now for each bubble in DYNAMIC() add to TEMP()
|
|
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
|
|
.I 'BUB!(NODE="") D LOGERR^IBDF18E2(3579602,.FORMID,FID,DYNAMIC(FID,COUNT)) Q
|
|
.S VALUE=$P(NODE,"^",4)
|
|
.S PI=$P(NODE,"^",3)
|
|
.S TEXT=$P(NODE,"^",8)
|
|
.; -- strip :: code from TEXT if it exists
|
|
.I TEXT[" :: " S TEXT=$$DISP^IBDFM1(TEXT)
|
|
.;I TEXT[" :: " S TEXT=$P(TEXT," :: ")
|
|
.S HEADER=""
|
|
.S FID=$P(NODE,"^",6)
|
|
.S ITEM=$P(NODE,"^")
|
|
.S QLFR=$P(NODE,"^",10)
|
|
.S TYPE=""
|
|
.S LEX=0
|
|
.S SLCTN=$P(NODE,"^",14) ;--added for modifiers, pointer fo file 357.3
|
|
.D SETTEMP^IBDF18E1
|
|
K DYNAMIC
|
|
;
|
|
;now for each hand print field in HANDPRNT() add to TEMP()
|
|
;
|
|
S HAND=0 F S HAND=$O(HANDPRNT(HAND)) Q:HAND="" S:HAND NODE=$G(^IBD(357.95,FORMTYPE,2,HAND,0)) D
|
|
.I 'HAND!(NODE="") D LOGERR^IBDF18E2(3579503,.FORMID,HAND,HANDPRNT(HAND)) Q
|
|
.S TYPE=$P(NODE,"^",17)
|
|
.S VALUE=HANDPRNT(HAND) S:$E(VALUE,$L(VALUE))="," VALUE=$E(VALUE,1,$L(VALUE)-1)
|
|
.;
|
|
.;what was printed may need transformation/formating
|
|
.S VALUE1=VALUE,VALUE=$$HPTRNS^IBDFU91(TYPE,VALUE,.FORMID)
|
|
.;
|
|
.; -- failed the input transform
|
|
.I VALUE="" D LOGERR^IBDF18E2(3579504,.FORMID,HAND,VALUE1,"","",TYPE) Q
|
|
.;
|
|
.S PI=$P(NODE,"^",4)
|
|
.S TEXT=$P(NODE,"^",7)
|
|
.S HEADER=$P(NODE,"^",9)
|
|
.S FID=$P(NODE,"^",8)
|
|
.S ITEM=$P(NODE,"^",12)
|
|
.S QLFR=$P(NODE,"^",10)
|
|
.S (LEX,NARR)=0
|
|
.S SLCTN=$P(NODE,"^",14) ;--added for modifiers, pointer to file 357.3
|
|
.I $P($G(^IBE(357.2,+$E(FID,2,$L(FID)),0)),U,18)=3 S NARR=1 ;Send both code and narrative
|
|
.D SETTEMP^IBDF18E1
|
|
K HANDPRNT
|
|
;
|
|
; --added to copy visit modifiers if any
|
|
;
|
|
D:$D(TEMP("ENCOUNTER")) VSTPXCA^IBDF18E0
|
|
;
|
|
D SETPXCA^IBDF18E0,PRO^IBDF18E0,SC^IBDF18E0
|
|
;
|
|
; -- do misc. passing to other packages that do not use PCE
|
|
;
|
|
D ^IBDF18E4
|
|
;
|
|
;
|
|
I $D(PXCA("IBD-ABORT")) D S PXCASTAT=0 G SENDQ
|
|
.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
|
|
..I +PXCA("IBD-ABORT",I,J)=3 K PXCA("IBD-ABORT",I,J) Q
|
|
..D LOGERR^IBDF18E2(3570004,.FORMID,"",$P(PXCA("IBD-ABORT",I,J),"^",2))
|
|
;
|
|
I +FORMID("SOURCE")=1 D QUE^IBDF18E3 G STAT
|
|
;
|
|
S IBD("AICS")=1 ;flag for IBDF PCE EVENT protocol
|
|
S IBD("PASSFLAG")=+$P($G(^IBD(357.09,1,0)),"^",7)
|
|
I $G(IBD("PASSFLAG"))<2 D VALIDATE^PXCA(.PXCA) I '$D(PXCA("ERROR")) D BACKGND^PXCA(.PXCA,.PXCASTAT)
|
|
I $G(IBD("PASSFLAG"))>1 D FOREGND^PXCA(.PXCA,.PXCASTAT)
|
|
K IBD("AICS"),IBD("PASSFLAG")
|
|
;
|
|
STAT S STATUS=$$FSCND^IBDF18C(FORMID,$S(PXCASTAT=0:4,PXCASTAT=1:3,1:12),$S(PXCASTAT=0:"PCE RETURNED AN ERROR",1:""))
|
|
;
|
|
; -- kill erroneous inpatient warnings
|
|
I $D(PXCA("WARNING","ENCOUNTER"))>0 D INPT^IBDF18E0($G(FORMID("DFN")),$G(FORMID("APPT")))
|
|
;
|
|
; -- log pce errors and warnings in AICS Error file
|
|
I $O(PXCA("ERROR",""))'=""!($O(PXCA("WARNING",""))'="") S FORMID("SOURCE")=99 D LOGERR^IBDF18E2(3570001,.FORMID)
|
|
;
|
|
; -- if pce returns an error unflag all pages as received and delete
|
|
; all scanned data so data can be re-scanned
|
|
SENDQ I $O(PXCA("ERROR",""))'=""!($O(PXCA("IBD-ABORT",""))'="") D UNRECV^IBDFBK2(FORMID)
|
|
Q +$G(PXCASTAT)
|