IBDFBK2 ;ALB/AAS - AICS broker Utilities ;23-May-95
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
RECV(RESULT,IBD) ; -- called by broker
; -- receives raw data array from scanning workstation and returns
; data may come in spurs, IBD("MOREDATA") = 1 if more data pending
;
; errors, warnings, and expanded data.
; Input : Result - (called by reference, see output)
; IBD - (called by reference) contains the raw
; data from the workstation (IBD(FD1) - IBD(FD9))
; IB("MOREDATA") - if more data pending.
;
; Output: RESULT - a new array element (result(lcnt) will be
; created for each error, warning and
; data element received
;
N I,J,X,Y,IBDATA,CNT,LCNT,IBDJ,INODE,ZTQUEUED,IOM,IBDF,PXCA,PXCAVSIT,ORVP,IBQUIT,SDFN,FORMID,DIE,DIC,DR,DA,DFN,D,D0,DA,DI,DK,DL,AUPNPAT,AUPNDOB,AUPNDOD,AUPNDAYS,AUPNSEX
I $D(IBD)=0 S RESULT(1)="NO DATA RECEIVED" G RECVQ
S ZTQUEUED="",IOM=80
;
S I=""
S IBDJ=$J
I $D(IBTEST) S IBDJ=$G(IBD("IBDJ"))
F S I=$O(IBD(I)) Q:I="" S ^TMP("IBD-SCAN-RAWDATA",IBDJ,I)=IBD(I)
I $G(IBD("MOREDATA")) S RESULT(1)="PARTIAL DATA RECEIVED" G RECVQ
;
S RESULT(1)="0^END OF DATA RECEIVED"
;
; -- parse strings
; data on workstation is built into strings upto 120 characters
; each data element delimited by a "~" and need to be parsed
; into an array IBDATA() which is then parsed into the bubbles,
; dynamic, and handprint arrays. IBDATA() represents data as it
; is received from the scanner.
;
S CNT=0
F I=1:1 S INODE="FD"_I S IBDATA=$G(^TMP("IBD-SCAN-RAWDATA",IBDJ,INODE)) Q:IBDATA="" D
. F J=1:1 S X=$P(IBDATA,"~",J) Q:X="" S CNT=CNT+1,IBDF(CNT)=X
;
S RESULT(1)="DATA PARSED INTO FIRST ARRAY"
K IBD
;
S RESULT(1)=$$PCE^IBDFBKR(.IBDF,.PXCA)
I $D(PXCA("ERROR")) S RESULT(1)="9^DATA REJECTED BY PCE: Critical data missing or incorrect"
I $D(PXCA("IBD-ABORT")) S RESULT(1)="9^DATA NOT SENT TO PCE"
S LCNT=1
;
; -- Don't try to parse array if data isn't valid
S IBQUIT=+RESULT(1),RESULT(1)=$P(RESULT(1),"^",2,99)
G:(IBQUIT<8!(IBQUIT>10)) RECVQ
D EW(.RESULT,.PXCA,.LCNT)
;
; -- create result array to pass back to workstation
D LSTDATA^IBDFBK3(.RESULT,.PXCA,.LCNT)
;
I '$D(IBTEST),'$G(IBD("MOREDATA")) K ^TMP("IBD-SCAN-RAWDATA",$J)
;remember to uncomment the line above - done 10/29/96 cmr
RECVQ I '$D(IBTEST) K PXCA,IBDF
;I IBQUIT<8
Q
;
EW(RESULT,PXCA,LCNT,AICS) ;
; -- List Errors and Warning generated in PCE
; Input : Result - (called by reference, see output)
; PXCA - (by referencethe array of data formated to
; the PCE device interface specification
; lcnt - (by reference) a counter for the result array
; Output: RESULT - a new array element result(lcnt) will be
; created for each error and warning received
;
N I,J,K,L,M,X,IBX
F M="ERROR","WARNING","AICS ERROR" I $D(PXCA(M)) D
.I $G(AICS),M="AICS ERROR" Q
.S I="" F S I=$O(PXCA(M,I)) Q:I="" S J="" F S J=$O(PXCA(M,I,J)) Q:J="" D
..S K="" F S K=$O(PXCA(M,I,J,K)) Q:K="" S L="" F S L=$O(PXCA(M,I,J,K,L)) Q:L="" S IBX=$G(PXCA(M,I,J,K,L)) D
...S X=M_": "_$P(IBX,"^")
...I $E(X,1,4)'="AICS" S X="PCE "_X
...I $P(IBX,"^",2)'="" S X=X_" - "_$P(IBX,"^",2)
...I $P(IBX,"^",3)'="" S X=X_" - "_$P(IBX,"^",3)
...I I="DIAGNOSIS/PROBLEM" S X=X_", ICD9: "_$P($G(^ICD9(+$G(PXCA(I,J,K)),0)),"^")_", "_$P($G(PXCA(I,J,K)),"^",13) I L=2,$P(PXCA(I,J,K),"^",2)="P" S $P(PXCA(I,J,K),"^",2)="S"
...I I="ENCOUNTER",L=15 S X=X_", "_$P($G(^VA(200,+$P($G(PXCA(I)),"^",4),0)),"^") I $P(PXCA(I),"^",15)="P" S $P(PXCA(I),"^",15)="S"
...D NEWLINE^IBDFBK3(.RESULT,X,.LCNT)
EWQ Q
;
UNRECV(FID) ; -- used by test to un received data when testing.
;
N IBI
I +$G(FID)<1 Q
S IBI=0 F S IBI=$O(^IBD(357.96,+FID,9,IBI)) Q:'IBI I $G(^IBD(357.96,+FID,9,IBI,0))'="" S $P(^(0),"^",2)=""
K ^IBD(357.96,+FID,10)
Q
;
RECVERR(FORMID,ER) ; -- error occurred in ibdfbkr, store in 359.3
Q:ER<11
S DIALOG=$S(ER=11:3579610,ER=12:3579607,ER=13:3579607,ER=14:3579604,ER=15:3579606,ER=16:3579605,ER=17:3579608,ER=18:3579609,1:3570001)
S FORMID=$G(FORMID("FORMID")),FORMID("SOURCE")=1
S FORMID("APPT")=$P($G(^IBD(357.96,+$G(FORMID),0)),"^",3)
D LOGERR^IBDF18E2(DIALOG,.FORMID)
Q
;
TESTR ;
S IBTEST="" K ALAN
S IBD("MOREDATA")=0
S IBD("IBDJ")=576718735
S FORMID=+$P($G(^TMP("IBD-SCAN-RAWDATA",IBD("IBDJ"),"FD1")),"FORMID=",2)
I +FORMID>0 D UNRECV(FORMID)
D RECV(.ALAN,.IBD)
W !! X "ZW ALAN W !! ZW PXCA"
K IBTEST
Q
IBDFBK2 ;ALB/AAS - AICS broker Utilities ;23-May-95
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
RECV(RESULT,IBD) ; -- called by broker
+1 ; -- receives raw data array from scanning workstation and returns
+2 ; data may come in spurs, IBD("MOREDATA") = 1 if more data pending
+3 ;
+4 ; errors, warnings, and expanded data.
+5 ; Input : Result - (called by reference, see output)
+6 ; IBD - (called by reference) contains the raw
+7 ; data from the workstation (IBD(FD1) - IBD(FD9))
+8 ; IB("MOREDATA") - if more data pending.
+9 ;
+10 ; Output: RESULT - a new array element (result(lcnt) will be
+11 ; created for each error, warning and
+12 ; data element received
+13 ;
+14 NEW I,J,X,Y,IBDATA,CNT,LCNT,IBDJ,INODE,ZTQUEUED,IOM,IBDF,PXCA,PXCAVSIT,ORVP,IBQUIT,SDFN,FORMID,DIE,DIC,DR,DA,DFN,D,D0,DA,DI,DK,DL,AUPNPAT,AUPNDOB,AUPNDOD,AUPNDAYS,AUPNSEX
+15 IF $DATA(IBD)=0
SET RESULT(1)="NO DATA RECEIVED"
GOTO RECVQ
+16 SET ZTQUEUED=""
SET IOM=80
+17 ;
+18 SET I=""
+19 SET IBDJ=$JOB
+20 IF $DATA(IBTEST)
SET IBDJ=$GET(IBD("IBDJ"))
+21 FOR
SET I=$ORDER(IBD(I))
IF I=""
QUIT
SET ^TMP("IBD-SCAN-RAWDATA",IBDJ,I)=IBD(I)
+22 IF $GET(IBD("MOREDATA"))
SET RESULT(1)="PARTIAL DATA RECEIVED"
GOTO RECVQ
+23 ;
+24 SET RESULT(1)="0^END OF DATA RECEIVED"
+25 ;
+26 ; -- parse strings
+27 ; data on workstation is built into strings upto 120 characters
+28 ; each data element delimited by a "~" and need to be parsed
+29 ; into an array IBDATA() which is then parsed into the bubbles,
+30 ; dynamic, and handprint arrays. IBDATA() represents data as it
+31 ; is received from the scanner.
+32 ;
+33 SET CNT=0
+34 FOR I=1:1
SET INODE="FD"_I
SET IBDATA=$GET(^TMP("IBD-SCAN-RAWDATA",IBDJ,INODE))
IF IBDATA=""
QUIT
Begin DoDot:1
+35 FOR J=1:1
SET X=$PIECE(IBDATA,"~",J)
IF X=""
QUIT
SET CNT=CNT+1
SET IBDF(CNT)=X
End DoDot:1
+36 ;
+37 SET RESULT(1)="DATA PARSED INTO FIRST ARRAY"
+38 KILL IBD
+39 ;
+40 SET RESULT(1)=$$PCE^IBDFBKR(.IBDF,.PXCA)
+41 IF $DATA(PXCA("ERROR"))
SET RESULT(1)="9^DATA REJECTED BY PCE: Critical data missing or incorrect"
+42 IF $DATA(PXCA("IBD-ABORT"))
SET RESULT(1)="9^DATA NOT SENT TO PCE"
+43 SET LCNT=1
+44 ;
+45 ; -- Don't try to parse array if data isn't valid
+46 SET IBQUIT=+RESULT(1)
SET RESULT(1)=$PIECE(RESULT(1),"^",2,99)
+47 IF (IBQUIT<8!(IBQUIT>10))
GOTO RECVQ
+48 DO EW(.RESULT,.PXCA,.LCNT)
+49 ;
+50 ; -- create result array to pass back to workstation
+51 DO LSTDATA^IBDFBK3(.RESULT,.PXCA,.LCNT)
+52 ;
+53 IF '$DATA(IBTEST)
IF '$GET(IBD("MOREDATA"))
KILL ^TMP("IBD-SCAN-RAWDATA",$JOB)
+54 ;remember to uncomment the line above - done 10/29/96 cmr
RECVQ IF '$DATA(IBTEST)
KILL PXCA,IBDF
+1 ;I IBQUIT<8
+2 QUIT
+3 ;
EW(RESULT,PXCA,LCNT,AICS) ;
+1 ; -- List Errors and Warning generated in PCE
+2 ; Input : Result - (called by reference, see output)
+3 ; PXCA - (by referencethe array of data formated to
+4 ; the PCE device interface specification
+5 ; lcnt - (by reference) a counter for the result array
+6 ; Output: RESULT - a new array element result(lcnt) will be
+7 ; created for each error and warning received
+8 ;
+9 NEW I,J,K,L,M,X,IBX
+10 FOR M="ERROR","WARNING","AICS ERROR"
IF $DATA(PXCA(M))
Begin DoDot:1
+11 IF $GET(AICS)
IF M="AICS ERROR"
QUIT
+12 SET I=""
FOR
SET I=$ORDER(PXCA(M,I))
IF I=""
QUIT
SET J=""
FOR
SET J=$ORDER(PXCA(M,I,J))
IF J=""
QUIT
Begin DoDot:2
+13 SET K=""
FOR
SET K=$ORDER(PXCA(M,I,J,K))
IF K=""
QUIT
SET L=""
FOR
SET L=$ORDER(PXCA(M,I,J,K,L))
IF L=""
QUIT
SET IBX=$GET(PXCA(M,I,J,K,L))
Begin DoDot:3
+14 SET X=M_": "_$PIECE(IBX,"^")
+15 IF $EXTRACT(X,1,4)'="AICS"
SET X="PCE "_X
+16 IF $PIECE(IBX,"^",2)'=""
SET X=X_" - "_$PIECE(IBX,"^",2)
+17 IF $PIECE(IBX,"^",3)'=""
SET X=X_" - "_$PIECE(IBX,"^",3)
+18 IF I="DIAGNOSIS/PROBLEM"
SET X=X_", ICD9: "_$PIECE($GET(^ICD9(+$GET(PXCA(I,J,K)),0)),"^")_", "_$PIECE($GET(PXCA(I,J,K)),"^",13)
IF L=2
IF $PIECE(PXCA(I,J,K),"^",2)="P"
SET $PIECE(PXCA(I,J,K),"^",2)="S"
+19 IF I="ENCOUNTER"
IF L=15
SET X=X_", "_$PIECE($GET(^VA(200,+$PIECE($GET(PXCA(I)),"^",4),0)),"^")
IF $PIECE(PXCA(I),"^",15)="P"
SET $PIECE(PXCA(I),"^",15)="S"
+20 DO NEWLINE^IBDFBK3(.RESULT,X,.LCNT)
End DoDot:3
End DoDot:2
End DoDot:1
EWQ QUIT
+1 ;
UNRECV(FID) ; -- used by test to un received data when testing.
+1 ;
+2 NEW IBI
+3 IF +$GET(FID)<1
QUIT
+4 SET IBI=0
FOR
SET IBI=$ORDER(^IBD(357.96,+FID,9,IBI))
IF 'IBI
QUIT
IF $GET(^IBD(357.96,+FID,9,IBI,0))'=""
SET $PIECE(^(0),"^",2)=""
+5 KILL ^IBD(357.96,+FID,10)
+6 QUIT
+7 ;
RECVERR(FORMID,ER) ; -- error occurred in ibdfbkr, store in 359.3
+1 IF ER<11
QUIT
+2 SET DIALOG=$SELECT(ER=11:3579610,ER=12:3579607,ER=13:3579607,ER=14:3579604,ER=15:3579606,ER=16:3579605,ER=17:3579608,ER=18:3579609,1:3570001)
+3 SET FORMID=$GET(FORMID("FORMID"))
SET FORMID("SOURCE")=1
+4 SET FORMID("APPT")=$PIECE($GET(^IBD(357.96,+$GET(FORMID),0)),"^",3)
+5 DO LOGERR^IBDF18E2(DIALOG,.FORMID)
+6 QUIT
+7 ;
TESTR ;
+1 SET IBTEST=""
KILL ALAN
+2 SET IBD("MOREDATA")=0
+3 SET IBD("IBDJ")=576718735
+4 SET FORMID=+$PIECE($GET(^TMP("IBD-SCAN-RAWDATA",IBD("IBDJ"),"FD1")),"FORMID=",2)
+5 IF +FORMID>0
DO UNRECV(FORMID)
+6 DO RECV(.ALAN,.IBD)
+7 WRITE !!
XECUTE "ZW ALAN W !! ZW PXCA"
+8 KILL IBTEST
+9 QUIT
