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