Routine: IBDFRPC4

IBDFRPC4 ;ALB/AAS - AICS Pass data to PCE, Broker Call ; 24-FEB-96

 ;;3.0;AUTOMATED INFO COLLECTION SYS;**38,36**;APR 24, 1997

 ; -- used by AICS Data Entry System, routine IBDFDE1

SEND(RESULT,IBDF) ; -- procedure

 ; -- broker call to set data into pxca array and send to pce

 ;    rpc  := IBD RECEIVE DATA

 ; -- input:      Result := passed by reference, see output

 ;            ibdf(text) := contains data about visit, plus checkout defined as follows:

 ;          ibdf("appt") := appointment data/time

 ;        ibdf("clinic") := clinic, pointer to file 44

 ;           ibdf("dfn") := patient, pointer to file 2

 ;          ibdf("form") := encounter form ID, pointer to file 357.96

 ;        ibdf("frmdef") := form definition, pointer to 357.95

 ;       ibdf("foregnd") := pass data in foreground, show results

 ;       ibdf("backgnd") := pass data in background, don't show results

 ;            ibdf("co") := check out date/time

 ;            ibdf("sc") := is visit for service connected condition

 ;            ibdf("ao") := is visit related to Agent orange

 ;            ibdf("ir") := is visit related to ionizing radiation

 ;            ibdf("ec") := is visit related to environmental contam.

 ;            ibdf("mst"):= is visit related to Military Sexual Trauma

 ;               ibdf(n) := where n>0 are user selections as follows:

 ;                   $p1 := package interface, pointer to file 357.6

 ;                   $p2 := value to send

 ;                   $p3 := display text

 ;                   $p4 := header to send

 ;                   $p5 := clin lexicon pointer

 ;                   $p6 := qualifier

 ;                   $p7 := ien of inteface

 ;                   $p8 := vitals type (.01 field in 359.1)

 ;                   $p9 := quantity

 N I,J,X,Y,D,D0,D1,D2,DA,DIC,DIE,DR,TNODE,FID,FORMID,NODE,VALUE,PI,TEXT,SUBHDR,HEADER,TYPE,QLFR,ITEM,PROVIDER,PXKDONE,STATUS,VSIT,QUANTITY,SDFN

 S RESULT="-1^No data passed"

 K PXCA

 S (PXCA,PXCASTAT)=""

 ; -- check form,frmdef and appt/clinic.  Need one or the other

 S TNODE=$G(^IBD(357.96,+$G(IBDF("FORM")),0))

 S:'$G(IBDF("DFN")) IBDF("DFN")=$P(TNODE,"^",2)

 S:'$G(IBDF("APPT")) IBDF("APPT")=$P(TNODE,"^",3)

 S:'$G(IBDF("FRMDEF")) IBDF("FRMDEF")=$P(TNODE,"^",4)

 S:'$G(IBDF("CLINIC")) IBDF("CLINIC")=$P(TNODE,"^",10)

 I '$G(IBDF("DFN"))!('$G(IBDF("APPT")))!('$G(IBDF("CLINIC"))) D  G END

 . I $G(IBDF("FORM")) S STATUS=$$FSCND^IBDF18C(+IBDF("FORM"),12)

 . S RESULT="-1^Critical information for processing missing"

 ; -- log manual data entry attempt in form tracking

 S STATUS=$$FSCND^IBDF18C(IBDF("FORM"),5)

 ; -- build the encounter node and source node from form tracking

 S PXCA("ENCOUNTER")=$G(IBDF("APPT"))_"^"_$G(IBDF("DFN"))_"^"_$G(IBDF("CLINIC"))_"^^^"_$G(IBDF("SC"))_"^"_$G(IBDF("AO"))_"^"_$G(IBDF("IR"))_"^"_$G(IBDF("EC"))_"^"_$G(IBDF("MST"))_"^^^^"_$G(IBDF("CO"))

 S PXCA("SOURCE")="1^"_DUZ_"^"_$G(IBDF("FRMDEF"))_"^^"_$G(IBDF("FORM"))

 ; -- process data in ibdf(n) nodes

 S FORMID=IBDF("FORM")

 S FID=0 F  S FID=$O(IBDF(FID)) Q:'FID  S NODE=$G(IBDF(FID)) D

 .N VALUE,PI,TEXT,SUBHDR,HEADER,TYPE,QLFR,ITEM,DELEX,QUANTITY

 .I NODE="" D LOGERR^IBDF18E2(3570002,.FORMID,FID) Q

 .S PI=$P(NODE,"^")

 .S VALUE=$$INPUT(PI,$P(NODE,"^",2))

 .S TEXT=$P(NODE,"^",3)

 .S (SUBHDR,HEADER)=$E($P(NODE,"^",4),1,80)

 .I $L(SUBHDR),$L(SUBHDR)<2 S (SUBHDR,HEADER)=""

 .;I $L(SUBHDR),($L(SUBHDR)+$L(TEXT)<80) S TEXT=SUBHDR_" "_TEXT

 .S QLFR=$P(NODE,"^",6) S:QLFR'="" QLFR=$O(^IBD(357.98,"B",QLFR,0))

 .S TYPE=+$$TYPE($P(NODE,"^",8))

 .S ITEM=FID

 .S DELEX=$P(NODE,"^",5)

 .S QUANTITY=$P(NODE,"^",9)

 .S SLCTN=$P(NODE,"^",12)

 .D SETTEMP^IBDF18E1

.Q

 ; --added to copy visit modifiers

 D:$D(TEMP("ENCOUNTER")) VSTPXCA^IBDF18E0

 D SETPXCA^IBDF18E0,PRO^IBDF18E0

 S IBDF("PASSFLAG")=+$P($G(^IBD(357.09,1,0)),"^",7)

 S IBD("AICS")=1 ;flag for IBDF PCE EVENT protocal

 ;I $G(IBDF("PASSFLAG"))<1 D BACKGND^PXCA(.PXCA,.PXCASTAT)

 ;I $G(IBDF("PASSFLAG"))=1 D VALIDATE^PXCA(.PXCA) I '$D(PXCA("ERROR")) D BACKGND^PXCA(.PXCA,.PXCASTAT)

 I $G(IBDF("PASSFLAG"))<2 D QUE^IBDF18E3

 I $G(IBDF("PASSFLAG"))>1 D FOREGND^PXCA(.PXCA,.PXCASTAT)

 K IBD("AICS")

 ; -- kill erroneous inpatient warnings

 I $D(PXCA("WARNING","ENCOUNTER"))>0 D INPT^IBDF18E0($G(IBDF("DFN")),$G(IBDF("APPT")))

 ; -- set form tracking processing status, if okay=6, if error=7

 I $G(IBDF("FORM")) S STATUS=$$FSCND^IBDF18C(IBDF("FORM"),$S(PXCASTAT=0:7,PXCASTAT=1:6,PXCASTAT=-1:7,PXCASTAT=-2:6,1:12),$S((PXCASTAT=0!(PXCASTAT=-1)):"PCE RETURNED AN ERROR",1:""))

 S RESULT(0)=PXCASTAT

 I (PXCASTAT=1!(PXCASTAT=-2)),IBDF("PASSFLAG")<3 K PXCA,PXCASTAT

END Q

INPUT(PI,X) ; -- convert external value to internal value

 I $G(PI)=""!($G(X)="")

 I $G(^IBE(357.6,+$G(PI),9))'="" X ^(9)

VALQ Q $G(X)

TYPE(X) ; -- Change external to internal for hand print fields

 N Y S Y=""

 I X'="" S Y=$O(^IBE(359.1,"B",X,0))

Q Y

IBDFRPC4  ;ALB/AAS - AICS Pass data to PCE, Broker Call ; 24-FEB-96

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;**38,36**;APR 24, 1997

 +2       ;

 +3       ; -- used by AICS Data Entry System, routine IBDFDE1

 +4       ;

SEND(RESULT,IBDF) ; -- procedure

 +1       ; -- broker call to set data into pxca array and send to pce

 +2       ;    rpc  := IBD RECEIVE DATA

 +3       ;

 +4       ; -- input:      Result := passed by reference, see output

 +5       ;            ibdf(text) := contains data about visit, plus checkout defined as follows:

 +6       ;          ibdf("appt") := appointment data/time

 +7       ;        ibdf("clinic") := clinic, pointer to file 44

 +8       ;           ibdf("dfn") := patient, pointer to file 2

 +9       ;          ibdf("form") := encounter form ID, pointer to file 357.96

 +10      ;        ibdf("frmdef") := form definition, pointer to 357.95

 +11      ;       ibdf("foregnd") := pass data in foreground, show results

 +12      ;       ibdf("backgnd") := pass data in background, don't show results

 +13      ;

 +14      ;            ibdf("co") := check out date/time

 +15      ;            ibdf("sc") := is visit for service connected condition

 +16      ;            ibdf("ao") := is visit related to Agent orange

 +17      ;            ibdf("ir") := is visit related to ionizing radiation

 +18      ;            ibdf("ec") := is visit related to environmental contam.

 +19      ;            ibdf("mst"):= is visit related to Military Sexual Trauma

 +20      ;

 +21      ;               ibdf(n) := where n>0 are user selections as follows:

 +22      ;                   $p1 := package interface, pointer to file 357.6

 +23      ;                   $p2 := value to send

 +24      ;                   $p3 := display text

 +25      ;                   $p4 := header to send

 +26      ;                   $p5 := clin lexicon pointer

 +27      ;                   $p6 := qualifier

 +28      ;                   $p7 := ien of inteface

 +29      ;                   $p8 := vitals type (.01 field in 359.1)

 +30      ;                   $p9 := quantity

 +31      ;

 +32       NEW I,J,X,Y,D,D0,D1,D2,DA,DIC,DIE,DR,TNODE,FID,FORMID,NODE,VALUE,PI,TEXT,SUBHDR,HEADER,TYPE,QLFR,ITEM,PROVIDER,PXKDONE,STATUS,VSIT,QUANTITY,SDFN

 +33       SET RESULT="-1^No data passed"

 +34      ;

 +35       KILL PXCA

 +36       SET (PXCA,PXCASTAT)=""

 +37      ;

 +38      ; -- check form,frmdef and appt/clinic.  Need one or the other

 +39       SET TNODE=$GET(^IBD(357.96,+$GET(IBDF("FORM")),0))

 +40       IF '$GET(IBDF("DFN"))

               SET IBDF("DFN")=$PIECE(TNODE,"^",2)

 +41       IF '$GET(IBDF("APPT"))

               SET IBDF("APPT")=$PIECE(TNODE,"^",3)

 +42       IF '$GET(IBDF("FRMDEF"))

               SET IBDF("FRMDEF")=$PIECE(TNODE,"^",4)

 +43       IF '$GET(IBDF("CLINIC"))

               SET IBDF("CLINIC")=$PIECE(TNODE,"^",10)

 +44      ;

 +45       IF '$GET(IBDF("DFN"))!('$GET(IBDF("APPT")))!('$GET(IBDF("CLINIC")))

               Begin DoDot:1

 +46               IF $GET(IBDF("FORM"))

                       SET STATUS=$$FSCND^IBDF18C(+IBDF("FORM"),12)

 +47               SET RESULT="-1^Critical information for processing missing"

               End DoDot:1

               GOTO END

 +48      ;

 +49      ; -- log manual data entry attempt in form tracking

 +50       SET STATUS=$$FSCND^IBDF18C(IBDF("FORM"),5)

 +51      ;

 +52      ; -- build the encounter node and source node from form tracking

 +53       SET PXCA("ENCOUNTER")=$GET(IBDF("APPT"))_"^"_$GET(IBDF("DFN"))_"^"_$GET(IBDF("CLINIC"))_"^^^"_$GET(IBDF("SC"))_"^"_$GET(IBDF("AO"))_"^"_$GET(IBDF("IR"))_"^"_$GET(IBDF("EC"))_"^"_$GET(IBDF("MST"))_"^^^^"_$GET(IBDF("CO"))

 +54       SET PXCA("SOURCE")="1^"_DUZ_"^"_$GET(IBDF("FRMDEF"))_"^^"_$GET(IBDF("FORM"))

 +55      ;

 +56      ; -- process data in ibdf(n) nodes

 +57       SET FORMID=IBDF("FORM")

 +58       SET FID=0

FOR

               SET FID=$ORDER(IBDF(FID))

               IF 'FID

                   QUIT

               SET NODE=$GET(IBDF(FID))

               Begin DoDot:1

 +59               NEW VALUE,PI,TEXT,SUBHDR,HEADER,TYPE,QLFR,ITEM,DELEX,QUANTITY

 +60               IF NODE=""

                       DO LOGERR^IBDF18E2(3570002,.FORMID,FID)

                       QUIT

 +61               SET PI=$PIECE(NODE,"^")

 +62               SET VALUE=$$INPUT(PI,$PIECE(NODE,"^",2))

 +63               SET TEXT=$PIECE(NODE,"^",3)

 +64               SET (SUBHDR,HEADER)=$EXTRACT($PIECE(NODE,"^",4),1,80)

 +65               IF $LENGTH(SUBHDR)

                       IF $LENGTH(SUBHDR)<2

                           SET (SUBHDR,HEADER)=""

 +66      ;I $L(SUBHDR),($L(SUBHDR)+$L(TEXT)<80) S TEXT=SUBHDR_" "_TEXT

 +67               SET QLFR=$PIECE(NODE,"^",6)

                   IF QLFR'=""

                       SET QLFR=$ORDER(^IBD(357.98,"B",QLFR,0))

 +68               SET TYPE=+$$TYPE($PIECE(NODE,"^",8))

 +69               SET ITEM=FID

 +70               SET DELEX=$PIECE(NODE,"^",5)

 +71               SET QUANTITY=$PIECE(NODE,"^",9)

 +72               SET SLCTN=$PIECE(NODE,"^",12)

 +73               DO SETTEMP^IBDF18E1

 +74               QUIT

               End DoDot:1

 +75      ;

 +76      ; --added to copy visit modifiers

 +77      ;

 +78       IF $DATA(TEMP("ENCOUNTER"))

               DO VSTPXCA^IBDF18E0

 +79      ;

 +80       DO SETPXCA^IBDF18E0

           DO PRO^IBDF18E0

 +81      ;

 +82       SET IBDF("PASSFLAG")=+$PIECE($GET(^IBD(357.09,1,0)),"^",7)

 +83      ;flag for IBDF PCE EVENT protocal

           SET IBD("AICS")=1

 +84      ;

 +85      ;I $G(IBDF("PASSFLAG"))<1 D BACKGND^PXCA(.PXCA,.PXCASTAT)

 +86      ;I $G(IBDF("PASSFLAG"))=1 D VALIDATE^PXCA(.PXCA) I '$D(PXCA("ERROR")) D BACKGND^PXCA(.PXCA,.PXCASTAT)

 +87       IF $GET(IBDF("PASSFLAG"))<2

               DO QUE^IBDF18E3

 +88       IF $GET(IBDF("PASSFLAG"))>1

               DO FOREGND^PXCA(.PXCA,.PXCASTAT)

 +89       KILL IBD("AICS")

 +90      ;

 +91      ; -- kill erroneous inpatient warnings

 +92       IF $DATA(PXCA("WARNING","ENCOUNTER"))>0

               DO INPT^IBDF18E0($GET(IBDF("DFN")),$GET(IBDF("APPT")))

 +93      ;

 +94      ; -- set form tracking processing status, if okay=6, if error=7

 +95       IF $GET(IBDF("FORM"))

               SET STATUS=$$FSCND^IBDF18C(IBDF("FORM"),$SELECT(PXCASTAT=0:7,PXCASTAT=1:6,PXCASTAT=-1:7,PXCASTAT=-2:6,1:12),$SELECT((PXCASTAT=0!(PXCASTAT=-1)):"PCE RETURNED AN ERROR",1:""))

 +96      ;

 +97       SET RESULT(0)=PXCASTAT

 +98       IF (PXCASTAT=1!(PXCASTAT=-2))

               IF IBDF("PASSFLAG")<3

                   KILL PXCA,PXCASTAT

END        QUIT

 +1       ;

INPUT(PI,X) ; -- convert external value to internal value

 +1        IF $GET(PI)=""!($GET(X)="")

 +2        IF $GET(^IBE(357.6,+$GET(PI),9))'=""

               XECUTE ^(9)

VALQ       QUIT $GET(X)

 +1       ;

TYPE(X)   ; -- Change external to internal for hand print fields

 +1        NEW Y

           SET Y=""

 +2        IF X'=""

               SET Y=$ORDER(^IBE(359.1,"B",X,0))

 +3        QUIT Y

IBDFRPC4.m