- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFBK2 4657 printed Jan 18, 2025@03:53:02 Page 2
- 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