IBDFBKR ;ALB/AAS - EF utilite, receive and format data for PCE ; OCT 1,1994
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
PCE(IB,PXCA) ;
; -- Entry point from Broker receiver to parse data and
; either send to PCE or store until all pages received
;
N %,%H,%I,I,J,X,Y,IBDATA,BUBBLES,HANDPRNT,DYNAMIC,RESULT,NEEDMORE,IBDA
S RESULT=1
;
; -- Move data from input format to data format
S RESULT=$$BRKARY(.IB,.IBDATA)
;
; -- check for valid data
S RESULT=$$VALIDD(.IBDATA) I RESULT>3 G PCEQ
;
; -- mark the page as having been received
S IBDA=$O(^IBD(357.96,IBDATA("FORMID"),9,"B",+IBDATA("PAGE"),0))_","_IBDATA("FORMID")_","
S FDA(357.969,IBDA,.02)=$$NOW^XLFDT
; -- marked stored image as received
S X=$O(^IBD(357.96,"AD",IBDATA("PAGE"),IBDATA("FORMID"),0)) I X D
.S FDA(357.963,X_","_IBDATA("FORMID")_",",.07)=1
D FILE^DIE("","FDA","IBDERR")
K DIC,DIE,DR,DA
;
; -- check if all pages have been rec'd (if not freeing ft entry)
S NEEDMORE=$$NEEDMOR(.IBDATA)
;
I NEEDMORE D
.S RESULT=6
.S I=0 F S I=$O(IBDF(I)) Q:'I D FILAD(IBDF(I)) Q:RESULT=11
.N SUCCESS S SUCCESS=$$FSCND^IBDF18C(IBDATA("FORMID"),11)
;
I 'NEEDMORE D
.N SUCCESS S SUCCESS=$$FSCND^IBDF18C(IBDATA("FORMID"),2)
.S RESULT=7
.S I=0 F S I=$O(IBDF(I)) Q:'I D ARYAD(IBDF(I))
.;
.; -- add to the arrays data from other pages stored in form tracking
.S I=0
.F S I=$O(^IBD(357.96,IBDATA("FORMID"),10,I)) Q:'I D ARYAD($G(^IBD(357.96,IBDATA("FORMID"),10,I,0)))
.;
.; -- don't need the raw data kept in form tracking anymore
.; -- maybe we do for formtracking???
.;K ^IBD(357.96,IBDATA("FORMID"),10)
.;
.I $$SEND^IBDF18E(IBDATA("FORMID"),"","",.BUBBLES,.HANDPRNT,"",.PXCA,.DYNAMIC)
.S RESULT=8
.;S RESULT=$S($G(PXCASTAT)=1:8,$G(PXCASTAT)=0:9,1:10)
.Q
;
PCEQ I +RESULT>10 D RECVERR^IBDFBK2(.IBDATA,+RESULT)
Q +RESULT_"^"_$P($T(RESULT+RESULT),";;",2)
;
FILAD(REC) ;
; -- adds the data to the FORM TRACKING file
; -- awaiting all of the pages to be sent
; REC is the line of raw data, as received
; -- may change to FM call???
;N CNT
Q:REC=""
; -- remove hard sets and replace with FM call
;S CNT=+$P($G(^IBD(357.96,IBDATA("FORMID"),10,0)),"^",3)
;F S CNT=CNT+1 Q:'$D(^IBD(357.96,IBDATA("FORMID"),10,CNT))
;S ^IBD(357.96,IBDATA("FORMID"),10,CNT,0)=REC
;S ^IBD(357.96,IBDATA("FORMID"),10,0)=$P($G(^IBD(357.96,IBDATA("FORMID"),10,0)),1,2)_"^"_CNT_"^"_CNT
;S ^IBD(357.96,IBDATA("FORMID"),10,"B",$E(REC,1,30),CNT)=""
;
L +^IBD(357.96,IBDATA("FORMID")):3 I '$T S RESULT=11 Q
S DIC="^IBD(357.96,"_IBDATA("FORMID")_",10,",DIC(0)="L",DIC("P")=$P(^DD(357.96,10,0),"^",2),DA(1)=IBDATA("FORMID"),X=REC,DLAYGO=357.96
K DD,DO D FILE^DICN K DIC,DA,DLAYGO,DD,DO
L -^IBD(357.96,IBDATA("FORMID"))
Q
;
ARYAD(DATA) ;
; -- Input DATA
; -- DATA format B=bubble or
; H=handprint>:<ien of form element in the form
; definition table>:<value entered
; D=dynamic bubble>:<field identifier>:<number of choice>
; -- Output Bubbles,Dynamic, or Handprint Array.
;
I $E(DATA,1)="""",$E(DATA,$L(DATA))="""" S DATA=$P(DATA,"""",2)
I $P(DATA,":")="B" S BUBBLES($P(DATA,":",2))=$P(DATA,":",3)
I $P(DATA,":")="D" S DYNAMIC($P(DATA,":",2),$P(DATA,":",3))=DATA
I $P(DATA,":")="H" S HANDPRNT($P(DATA,":",2))=$P(DATA,":",3,10)
Q
;
BRKARY(IB,IBDATA) ;
; -- break array of data into known parts
; -- Input IB(array) contains raw data from receiver
; IBDATA(array) called by reference
; -- Output IBDATA(array) of new formated data
; result message indicator
;
N I,X,CNT
S (I,CNT)=0
F S I=$O(IBDF(I)) Q:'I!(CNT>3) D
.I $P(IB(I),"=")="FORMTYPE" S IBDATA("FORMTYPE")=+$P(IBDF(I),"=",2),CNT=CNT+1 K IBDF(I) Q
.I $P(IB(I),"=")="FORMID" S IBDATA("FORMID")=+$P(IBDF(I),"=",2),CNT=CNT+1 K IBDF(I) Q
.I $P(IB(I),"=")="PAGE" S IBDATA("PAGE")=+$P(IBDF(I),"=",2),CNT=CNT+1 K IBDF(I) Q
.I $P(IB(I),"=")="DATA" S CNT=CNT+1 K IBDF(I) Q ; shouldn't contain data
BRKQ Q 2
;
VALIDD(IBDATA) ;
; -- Determine if data contains Formtype, FormID, and Page
; -- Does form ID and form type match entry in Form Tracking
; -- is the form supposed to have this page?
; -- Input IBDATA(array)
; -- Output result message indicator (3=valid, 4=invalid, 5=already recvd)
;
N X S X=12 D
.I '$G(IBDATA("FORMTYPE")) S X=13 Q
.I '$G(IBDATA("FORMID")) S X=14 Q
.I '$G(IBDATA("PAGE")) S X=15 Q
.;
.I $G(^IBD(357.96,+IBDATA("FORMID"),0))="" S X=16 Q
.I $P($G(^IBD(357.96,+IBDATA("FORMID"),0)),"^",4)'=IBDATA("FORMTYPE") S X=17 Q
.;
.I '$O(^IBD(357.96,IBDATA("FORMID"),9,"B",IBDATA("PAGE"),0)) S X=18 Q
.;
.; -- if pce returned an error then all pages flagged as not received
.I $P(^IBD(357.96,IBDATA("FORMID"),9,+$O(^IBD(357.96,IBDATA("FORMID"),9,"B",IBDATA("PAGE"),0)),0),"^",2) S X=5 Q
.S X=3
VQ Q X
;
NEEDMOR(IBDATA) ;
; -- check to see if all the pages have been received
N I,X
S (I,X)=0
F S I=$O(^IBD(357.96,IBDATA("FORMID"),9,I)) Q:'I D
.I $G(^IBD(357.96,IBDATA("FORMID"),9,I,0)),'$P(^(0),"^",2) S X=1 Q
.Q
NMQ Q X
;
RESULT ;;
;;Beginning to Format Data for PCE
;;Data Accepted, Beginning Validity Check
;;Valid Form Identity Received
;;Form ID Validity Rejected
;;Data from Page already Received
;;Waiting for more pages to be recognized
;;Formatting data for PCE
;;Data Sent to PCE
;;Data Rejected by PCE
;;Unknown result in sending data to PCE
;;Form Tracking Entry locked by another user, Editing not allowed
;;Form ID Validity Rejected
;;Form Definition of zero or null is invalid
;;Form ID of zero or null is invalid
;;Form Page number of zero or null is invalid
;;Form Tracking entry does not exist
;;Form Definition from scanning doesn't match data in Form Tracking
;;Data from non-scannable page was passed
;;Form Rejected, Patient not in clinic
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFBKR 5917 printed Dec 13, 2024@02:51:53 Page 2
IBDFBKR ;ALB/AAS - EF utilite, receive and format data for PCE ; OCT 1,1994
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
PCE(IB,PXCA) ;
+1 ; -- Entry point from Broker receiver to parse data and
+2 ; either send to PCE or store until all pages received
+3 ;
+4 NEW %,%H,%I,I,J,X,Y,IBDATA,BUBBLES,HANDPRNT,DYNAMIC,RESULT,NEEDMORE,IBDA
+5 SET RESULT=1
+6 ;
+7 ; -- Move data from input format to data format
+8 SET RESULT=$$BRKARY(.IB,.IBDATA)
+9 ;
+10 ; -- check for valid data
+11 SET RESULT=$$VALIDD(.IBDATA)
IF RESULT>3
GOTO PCEQ
+12 ;
+13 ; -- mark the page as having been received
+14 SET IBDA=$ORDER(^IBD(357.96,IBDATA("FORMID"),9,"B",+IBDATA("PAGE"),0))_","_IBDATA("FORMID")_","
+15 SET FDA(357.969,IBDA,.02)=$$NOW^XLFDT
+16 ; -- marked stored image as received
+17 SET X=$ORDER(^IBD(357.96,"AD",IBDATA("PAGE"),IBDATA("FORMID"),0))
IF X
Begin DoDot:1
+18 SET FDA(357.963,X_","_IBDATA("FORMID")_",",.07)=1
End DoDot:1
+19 DO FILE^DIE("","FDA","IBDERR")
+20 KILL DIC,DIE,DR,DA
+21 ;
+22 ; -- check if all pages have been rec'd (if not freeing ft entry)
+23 SET NEEDMORE=$$NEEDMOR(.IBDATA)
+24 ;
+25 IF NEEDMORE
Begin DoDot:1
+26 SET RESULT=6
+27 SET I=0
FOR
SET I=$ORDER(IBDF(I))
if 'I
QUIT
DO FILAD(IBDF(I))
if RESULT=11
QUIT
+28 NEW SUCCESS
SET SUCCESS=$$FSCND^IBDF18C(IBDATA("FORMID"),11)
End DoDot:1
+29 ;
+30 IF 'NEEDMORE
Begin DoDot:1
+31 NEW SUCCESS
SET SUCCESS=$$FSCND^IBDF18C(IBDATA("FORMID"),2)
+32 SET RESULT=7
+33 SET I=0
FOR
SET I=$ORDER(IBDF(I))
if 'I
QUIT
DO ARYAD(IBDF(I))
+34 ;
+35 ; -- add to the arrays data from other pages stored in form tracking
+36 SET I=0
+37 FOR
SET I=$ORDER(^IBD(357.96,IBDATA("FORMID"),10,I))
if 'I
QUIT
DO ARYAD($GET(^IBD(357.96,IBDATA("FORMID"),10,I,0)))
+38 ;
+39 ; -- don't need the raw data kept in form tracking anymore
+40 ; -- maybe we do for formtracking???
+41 ;K ^IBD(357.96,IBDATA("FORMID"),10)
+42 ;
+43 IF $$SEND^IBDF18E(IBDATA("FORMID"),"","",.BUBBLES,.HANDPRNT,"",.PXCA,.DYNAMIC)
+44 SET RESULT=8
+45 ;S RESULT=$S($G(PXCASTAT)=1:8,$G(PXCASTAT)=0:9,1:10)
+46 QUIT
End DoDot:1
+47 ;
PCEQ IF +RESULT>10
DO RECVERR^IBDFBK2(.IBDATA,+RESULT)
+1 QUIT +RESULT_"^"_$PIECE($TEXT(RESULT+RESULT),";;",2)
+2 ;
FILAD(REC) ;
+1 ; -- adds the data to the FORM TRACKING file
+2 ; -- awaiting all of the pages to be sent
+3 ; REC is the line of raw data, as received
+4 ; -- may change to FM call???
+5 ;N CNT
+6 if REC=""
QUIT
+7 ; -- remove hard sets and replace with FM call
+8 ;S CNT=+$P($G(^IBD(357.96,IBDATA("FORMID"),10,0)),"^",3)
+9 ;F S CNT=CNT+1 Q:'$D(^IBD(357.96,IBDATA("FORMID"),10,CNT))
+10 ;S ^IBD(357.96,IBDATA("FORMID"),10,CNT,0)=REC
+11 ;S ^IBD(357.96,IBDATA("FORMID"),10,0)=$P($G(^IBD(357.96,IBDATA("FORMID"),10,0)),1,2)_"^"_CNT_"^"_CNT
+12 ;S ^IBD(357.96,IBDATA("FORMID"),10,"B",$E(REC,1,30),CNT)=""
+13 ;
+14 LOCK +^IBD(357.96,IBDATA("FORMID")):3
IF '$TEST
SET RESULT=11
QUIT
+15 SET DIC="^IBD(357.96,"_IBDATA("FORMID")_",10,"
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(357.96,10,0),"^",2)
SET DA(1)=IBDATA("FORMID")
SET X=REC
SET DLAYGO=357.96
+16 KILL DD,DO
DO FILE^DICN
KILL DIC,DA,DLAYGO,DD,DO
+17 LOCK -^IBD(357.96,IBDATA("FORMID"))
+18 QUIT
+19 ;
ARYAD(DATA) ;
+1 ; -- Input DATA
+2 ; -- DATA format B=bubble or
+3 ; H=handprint>:<ien of form element in the form
+4 ; definition table>:<value entered
+5 ; D=dynamic bubble>:<field identifier>:<number of choice>
+6 ; -- Output Bubbles,Dynamic, or Handprint Array.
+7 ;
+8 IF $EXTRACT(DATA,1)=""""
IF $EXTRACT(DATA,$LENGTH(DATA))=""""
SET DATA=$PIECE(DATA,"""",2)
+9 IF $PIECE(DATA,":")="B"
SET BUBBLES($PIECE(DATA,":",2))=$PIECE(DATA,":",3)
+10 IF $PIECE(DATA,":")="D"
SET DYNAMIC($PIECE(DATA,":",2),$PIECE(DATA,":",3))=DATA
+11 IF $PIECE(DATA,":")="H"
SET HANDPRNT($PIECE(DATA,":",2))=$PIECE(DATA,":",3,10)
+12 QUIT
+13 ;
BRKARY(IB,IBDATA) ;
+1 ; -- break array of data into known parts
+2 ; -- Input IB(array) contains raw data from receiver
+3 ; IBDATA(array) called by reference
+4 ; -- Output IBDATA(array) of new formated data
+5 ; result message indicator
+6 ;
+7 NEW I,X,CNT
+8 SET (I,CNT)=0
+9 FOR
SET I=$ORDER(IBDF(I))
if 'I!(CNT>3)
QUIT
Begin DoDot:1
+10 IF $PIECE(IB(I),"=")="FORMTYPE"
SET IBDATA("FORMTYPE")=+$PIECE(IBDF(I),"=",2)
SET CNT=CNT+1
KILL IBDF(I)
QUIT
+11 IF $PIECE(IB(I),"=")="FORMID"
SET IBDATA("FORMID")=+$PIECE(IBDF(I),"=",2)
SET CNT=CNT+1
KILL IBDF(I)
QUIT
+12 IF $PIECE(IB(I),"=")="PAGE"
SET IBDATA("PAGE")=+$PIECE(IBDF(I),"=",2)
SET CNT=CNT+1
KILL IBDF(I)
QUIT
+13 ; shouldn't contain data
IF $PIECE(IB(I),"=")="DATA"
SET CNT=CNT+1
KILL IBDF(I)
QUIT
End DoDot:1
BRKQ QUIT 2
+1 ;
VALIDD(IBDATA) ;
+1 ; -- Determine if data contains Formtype, FormID, and Page
+2 ; -- Does form ID and form type match entry in Form Tracking
+3 ; -- is the form supposed to have this page?
+4 ; -- Input IBDATA(array)
+5 ; -- Output result message indicator (3=valid, 4=invalid, 5=already recvd)
+6 ;
+7 NEW X
SET X=12
Begin DoDot:1
+8 IF '$GET(IBDATA("FORMTYPE"))
SET X=13
QUIT
+9 IF '$GET(IBDATA("FORMID"))
SET X=14
QUIT
+10 IF '$GET(IBDATA("PAGE"))
SET X=15
QUIT
+11 ;
+12 IF $GET(^IBD(357.96,+IBDATA("FORMID"),0))=""
SET X=16
QUIT
+13 IF $PIECE($GET(^IBD(357.96,+IBDATA("FORMID"),0)),"^",4)'=IBDATA("FORMTYPE")
SET X=17
QUIT
+14 ;
+15 IF '$ORDER(^IBD(357.96,IBDATA("FORMID"),9,"B",IBDATA("PAGE"),0))
SET X=18
QUIT
+16 ;
+17 ; -- if pce returned an error then all pages flagged as not received
+18 IF $PIECE(^IBD(357.96,IBDATA("FORMID"),9,+$ORDER(^IBD(357.96,IBDATA("FORMID"),9,"B",IBDATA("PAGE"),0)),0),"^",2)
SET X=5
QUIT
+19 SET X=3
End DoDot:1
VQ QUIT X
+1 ;
NEEDMOR(IBDATA) ;
+1 ; -- check to see if all the pages have been received
+2 NEW I,X
+3 SET (I,X)=0
+4 FOR
SET I=$ORDER(^IBD(357.96,IBDATA("FORMID"),9,I))
if 'I
QUIT
Begin DoDot:1
+5 IF $GET(^IBD(357.96,IBDATA("FORMID"),9,I,0))
IF '$PIECE(^(0),"^",2)
SET X=1
QUIT
+6 QUIT
End DoDot:1
NMQ QUIT X
+1 ;
RESULT ;;
+1 ;;Beginning to Format Data for PCE
+2 ;;Data Accepted, Beginning Validity Check
+3 ;;Valid Form Identity Received
+4 ;;Form ID Validity Rejected
+5 ;;Data from Page already Received
+6 ;;Waiting for more pages to be recognized
+7 ;;Formatting data for PCE
+8 ;;Data Sent to PCE
+9 ;;Data Rejected by PCE
+10 ;;Unknown result in sending data to PCE
+11 ;;Form Tracking Entry locked by another user, Editing not allowed
+12 ;;Form ID Validity Rejected
+13 ;;Form Definition of zero or null is invalid
+14 ;;Form ID of zero or null is invalid
+15 ;;Form Page number of zero or null is invalid
+16 ;;Form Tracking entry does not exist
+17 ;;Form Definition from scanning doesn't match data in Form Tracking
+18 ;;Data from non-scannable page was passed
+19 ;;Form Rejected, Patient not in clinic
