- 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)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF18E 7579 printed Jan 18, 2025@03:52:07 Page 2
- IBDF18E ;ALB/CJM - ENCOUNTER FORM - PCE DEVICE INTERFACE utilities ;04-OCT-94
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**3,25,38,37**;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,FNM,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 SET FNM=$PIECE(NODE,"^",5)
- +51 ; -- strip :: code from TEXT if it exists
- +52 IF TEXT[" :: "
- SET TEXT=$$DISP^IBDFM1(TEXT)
- +53 ;I TEXT[" :: ",PI,VALUE D
- +54 ;.S (Y,X)=VALUE X $G(^IBE(357.6,PI,14)) I Y]"" S TEXT=$P(TEXT," :: "_Y)
- +55 SET SUBHDR=$GET(^IBD(357.95,FORMTYPE,1,BUB,1))
- +56 ;
- +57 ; -- the following line causes the subheader and display text to
- +58 ; to be concatenated except for IB, which can pass an alternate
- +59 ; text. (some don't like this when passed to Problem List)
- +60 ; This may need to be re-visited in the future
- +61 IF +FORMID("SOURCE")'=1
- IF $LENGTH(SUBHDR)
- IF ($LENGTH(SUBHDR)+$LENGTH(TEXT)<80)
- SET TEXT=SUBHDR_" "_TEXT
- +62 SET HEADER=$PIECE(NODE,"^",9)
- +63 ;PANDAS uses piece 1 to number each bubble - does not use piece 6
- SET FID=$PIECE(NODE,"^",6)
- IF FID=""
- SET FID=$PIECE(NODE,"^")
- +64 SET ITEM=$PIECE(NODE,"^",12)
- +65 SET QLFR=$PIECE(NODE,"^",10)
- +66 SET QUANTITY=$PIECE(NODE,"^",13)
- +67 ;--added for modifiers, pointer to file 357.3
- SET SLCTN=$PIECE(NODE,"^",14)
- +68 ;
- +69 ; -- if text contains 'x #' for quantity, strip it
- +70 ;I +QUANTITY I TEXT[(" x "_QUANTITY) S TEXT=$TR(TEXT," x "_QUANTITY)
- +71 IF +QUANTITY
- IF TEXT[(" x "_QUANTITY)
- Begin DoDot:2
- +72 SET X=" x "_QUANTITY
- +73 SET TEXT=$EXTRACT(TEXT,1,$FIND(TEXT,X)-($LENGTH(X)+1))_$EXTRACT(TEXT,$FIND(TEXT,X),$LENGTH(TEXT))
- End DoDot:2
- +74 ;
- +75 SET TYPE=""
- SET (LEX,NARR)=0
- +76 IF $DATA(^IBD(357.95,FORMTYPE,1,BUB,2))
- SET LEX=$PIECE($GET(^IBD(357.95,FORMTYPE,1,BUB,2)),"^",2)
- +77 DO SETTEMP^IBDF18E1
- +78 DO CODES^IBDF18E0
- End DoDot:1
- +79 KILL BUBBLES
- +80 ;
- +81 ;now for each bubble in DYNAMIC() add to TEMP()
- +82 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
- +83 IF 'BUB!(NODE="")
- DO LOGERR^IBDF18E2(3579602,.FORMID,FID,DYNAMIC(FID,COUNT))
- QUIT
- +84 SET VALUE=$PIECE(NODE,"^",4)
- +85 SET PI=$PIECE(NODE,"^",3)
- +86 SET TEXT=$PIECE(NODE,"^",8)
- +87 ; -- strip :: code from TEXT if it exists
- +88 IF TEXT[" :: "
- SET TEXT=$$DISP^IBDFM1(TEXT)
- +89 ;I TEXT[" :: " S TEXT=$P(TEXT," :: ")
- +90 SET HEADER=""
- +91 SET FID=$PIECE(NODE,"^",6)
- +92 SET ITEM=$PIECE(NODE,"^")
- +93 SET QLFR=$PIECE(NODE,"^",10)
- +94 SET TYPE=""
- +95 SET LEX=0
- +96 ;--added for modifiers, pointer fo file 357.3
- SET SLCTN=$PIECE(NODE,"^",14)
- +97 DO SETTEMP^IBDF18E1
- End DoDot:1
- +98 KILL DYNAMIC
- +99 ;
- +100 ;now for each hand print field in HANDPRNT() add to TEMP()
- +101 ;
- +102 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
- +103 IF 'HAND!(NODE="")
- DO LOGERR^IBDF18E2(3579503,.FORMID,HAND,HANDPRNT(HAND))
- QUIT
- +104 SET TYPE=$PIECE(NODE,"^",17)
- +105 SET VALUE=HANDPRNT(HAND)
- if $EXTRACT(VALUE,$LENGTH(VALUE))=","
- SET VALUE=$EXTRACT(VALUE,1,$LENGTH(VALUE)-1)
- +106 ;
- +107 ;what was printed may need transformation/formating
- +108 SET VALUE1=VALUE
- SET VALUE=$$HPTRNS^IBDFU91(TYPE,VALUE,.FORMID)
- +109 ;
- +110 ; -- failed the input transform
- +111 IF VALUE=""
- DO LOGERR^IBDF18E2(3579504,.FORMID,HAND,VALUE1,"","",TYPE)
- QUIT
- +112 ;
- +113 SET PI=$PIECE(NODE,"^",4)
- +114 SET TEXT=$PIECE(NODE,"^",7)
- +115 SET HEADER=$PIECE(NODE,"^",9)
- +116 SET FID=$PIECE(NODE,"^",8)
- +117 SET ITEM=$PIECE(NODE,"^",12)
- +118 SET QLFR=$PIECE(NODE,"^",10)
- +119 SET (LEX,NARR)=0
- +120 ;--added for modifiers, pointer to file 357.3
- SET SLCTN=$PIECE(NODE,"^",14)
- +121 ;Send both code and narrative
- IF $PIECE($GET(^IBE(357.2,+$EXTRACT(FID,2,$LENGTH(FID)),0)),U,18)=3
- SET NARR=1
- +122 DO SETTEMP^IBDF18E1
- End DoDot:1
- +123 KILL HANDPRNT
- +124 ;
- +125 ; --added to copy visit modifiers if any
- +126 ;
- +127 if $DATA(TEMP("ENCOUNTER"))
- DO VSTPXCA^IBDF18E0
- +128 ;
- +129 DO SETPXCA^IBDF18E0
- DO PRO^IBDF18E0
- DO SC^IBDF18E0
- +130 ;
- +131 ; -- do misc. passing to other packages that do not use PCE
- +132 ;
- +133 DO ^IBDF18E4
- +134 ;
- +135 ;
- +136 IF $DATA(PXCA("IBD-ABORT"))
- Begin DoDot:1
- +137 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
- +138 IF +PXCA("IBD-ABORT",I,J)=3
- KILL PXCA("IBD-ABORT",I,J)
- QUIT
- +139 DO LOGERR^IBDF18E2(3570004,.FORMID,"",$PIECE(PXCA("IBD-ABORT",I,J),"^",2))
- End DoDot:2
- End DoDot:1
- SET PXCASTAT=0
- GOTO SENDQ
- +140 ;
- +141 IF +FORMID("SOURCE")=1
- DO QUE^IBDF18E3
- GOTO STAT
- +142 ;
- +143 ;flag for IBDF PCE EVENT protocol
- SET IBD("AICS")=1
- +144 SET IBD("PASSFLAG")=+$PIECE($GET(^IBD(357.09,1,0)),"^",7)
- +145 IF $GET(IBD("PASSFLAG"))<2
- DO VALIDATE^PXCA(.PXCA)
- IF '$DATA(PXCA("ERROR"))
- DO BACKGND^PXCA(.PXCA,.PXCASTAT)
- +146 IF $GET(IBD("PASSFLAG"))>1
- DO FOREGND^PXCA(.PXCA,.PXCASTAT)
- +147 KILL IBD("AICS"),IBD("PASSFLAG")
- +148 ;
- 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)