Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDF18E

IBDF18E.m

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