- 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 Feb 19, 2025@00:18:18 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
