IBDFRPC4 ;ALB/AAS - AICS Pass data to PCE, Broker Call ; 24-FEB-96
;;3.0;AUTOMATED INFO COLLECTION SYS;**38,36,37**;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
;
; send misc. data that does not go to PCE
D ^IBDF18E4
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFRPC4 5089 printed Apr 09, 2024@21:58:39 Page 2
IBDFRPC4 ;ALB/AAS - AICS Pass data to PCE, Broker Call ; 24-FEB-96
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**38,36,37**;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 ; send misc. data that does not go to PCE
+83 DO ^IBDF18E4
+84 ;
+85 SET IBDF("PASSFLAG")=+$PIECE($GET(^IBD(357.09,1,0)),"^",7)
+86 ;flag for IBDF PCE EVENT protocal
SET IBD("AICS")=1
+87 ;
+88 ;I $G(IBDF("PASSFLAG"))<1 D BACKGND^PXCA(.PXCA,.PXCASTAT)
+89 ;I $G(IBDF("PASSFLAG"))=1 D VALIDATE^PXCA(.PXCA) I '$D(PXCA("ERROR")) D BACKGND^PXCA(.PXCA,.PXCASTAT)
+90 IF $GET(IBDF("PASSFLAG"))<2
DO QUE^IBDF18E3
+91 IF $GET(IBDF("PASSFLAG"))>1
DO FOREGND^PXCA(.PXCA,.PXCASTAT)
+92 KILL IBD("AICS")
+93 ;
+94 ; -- kill erroneous inpatient warnings
+95 IF $DATA(PXCA("WARNING","ENCOUNTER"))>0
DO INPT^IBDF18E0($GET(IBDF("DFN")),$GET(IBDF("APPT")))
+96 ;
+97 ; -- set form tracking processing status, if okay=6, if error=7
+98 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:""))
+99 ;
+100 SET RESULT(0)=PXCASTAT
+101 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
