source: FOIAVistA/tag/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFBK2.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1IBDFBK2 ;ALB/AAS - AICS broker Utilities ;23-May-95
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4RECV(RESULT,IBD) ; -- called by broker
5 ; -- receives raw data array from scanning workstation and returns
6 ; data may come in spurs, IBD("MOREDATA") = 1 if more data pending
7 ;
8 ; errors, warnings, and expanded data.
9 ; Input : Result - (called by reference, see output)
10 ; IBD - (called by reference) contains the raw
11 ; data from the workstation (IBD(FD1) - IBD(FD9))
12 ; IB("MOREDATA") - if more data pending.
13 ;
14 ; Output: RESULT - a new array element (result(lcnt) will be
15 ; created for each error, warning and
16 ; data element received
17 ;
18 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
19 I $D(IBD)=0 S RESULT(1)="NO DATA RECEIVED" G RECVQ
20 S ZTQUEUED="",IOM=80
21 ;
22 S I=""
23 S IBDJ=$J
24 I $D(IBTEST) S IBDJ=$G(IBD("IBDJ"))
25 F S I=$O(IBD(I)) Q:I="" S ^TMP("IBD-SCAN-RAWDATA",IBDJ,I)=IBD(I)
26 I $G(IBD("MOREDATA")) S RESULT(1)="PARTIAL DATA RECEIVED" G RECVQ
27 ;
28 S RESULT(1)="0^END OF DATA RECEIVED"
29 ;
30 ; -- parse strings
31 ; data on workstation is built into strings upto 120 characters
32 ; each data element delimited by a "~" and need to be parsed
33 ; into an array IBDATA() which is then parsed into the bubbles,
34 ; dynamic, and handprint arrays. IBDATA() represents data as it
35 ; is received from the scanner.
36 ;
37 S CNT=0
38 F I=1:1 S INODE="FD"_I S IBDATA=$G(^TMP("IBD-SCAN-RAWDATA",IBDJ,INODE)) Q:IBDATA="" D
39 . F J=1:1 S X=$P(IBDATA,"~",J) Q:X="" S CNT=CNT+1,IBDF(CNT)=X
40 ;
41 S RESULT(1)="DATA PARSED INTO FIRST ARRAY"
42 K IBD
43 ;
44 S RESULT(1)=$$PCE^IBDFBKR(.IBDF,.PXCA)
45 I $D(PXCA("ERROR")) S RESULT(1)="9^DATA REJECTED BY PCE: Critical data missing or incorrect"
46 I $D(PXCA("IBD-ABORT")) S RESULT(1)="9^DATA NOT SENT TO PCE"
47 S LCNT=1
48 ;
49 ; -- Don't try to parse array if data isn't valid
50 S IBQUIT=+RESULT(1),RESULT(1)=$P(RESULT(1),"^",2,99)
51 G:(IBQUIT<8!(IBQUIT>10)) RECVQ
52 D EW(.RESULT,.PXCA,.LCNT)
53 ;
54 ; -- create result array to pass back to workstation
55 D LSTDATA^IBDFBK3(.RESULT,.PXCA,.LCNT)
56 ;
57 I '$D(IBTEST),'$G(IBD("MOREDATA")) K ^TMP("IBD-SCAN-RAWDATA",$J)
58 ;remember to uncomment the line above - done 10/29/96 cmr
59RECVQ I '$D(IBTEST) K PXCA,IBDF
60 ;I IBQUIT<8
61 Q
62 ;
63EW(RESULT,PXCA,LCNT,AICS) ;
64 ; -- List Errors and Warning generated in PCE
65 ; Input : Result - (called by reference, see output)
66 ; PXCA - (by referencethe array of data formated to
67 ; the PCE device interface specification
68 ; lcnt - (by reference) a counter for the result array
69 ; Output: RESULT - a new array element result(lcnt) will be
70 ; created for each error and warning received
71 ;
72 N I,J,K,L,M,X,IBX
73 F M="ERROR","WARNING","AICS ERROR" I $D(PXCA(M)) D
74 .I $G(AICS),M="AICS ERROR" Q
75 .S I="" F S I=$O(PXCA(M,I)) Q:I="" S J="" F S J=$O(PXCA(M,I,J)) Q:J="" D
76 ..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
77 ...S X=M_": "_$P(IBX,"^")
78 ...I $E(X,1,4)'="AICS" S X="PCE "_X
79 ...I $P(IBX,"^",2)'="" S X=X_" - "_$P(IBX,"^",2)
80 ...I $P(IBX,"^",3)'="" S X=X_" - "_$P(IBX,"^",3)
81 ...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"
82 ...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"
83 ...D NEWLINE^IBDFBK3(.RESULT,X,.LCNT)
84EWQ Q
85 ;
86UNRECV(FID) ; -- used by test to un received data when testing.
87 ;
88 N IBI
89 I +$G(FID)<1 Q
90 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)=""
91 K ^IBD(357.96,+FID,10)
92 Q
93 ;
94RECVERR(FORMID,ER) ; -- error occurred in ibdfbkr, store in 359.3
95 Q:ER<11
96 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)
97 S FORMID=$G(FORMID("FORMID")),FORMID("SOURCE")=1
98 S FORMID("APPT")=$P($G(^IBD(357.96,+$G(FORMID),0)),"^",3)
99 D LOGERR^IBDF18E2(DIALOG,.FORMID)
100 Q
101 ;
102TESTR ;
103 S IBTEST="" K ALAN
104 S IBD("MOREDATA")=0
105 S IBD("IBDJ")=576718735
106 S FORMID=+$P($G(^TMP("IBD-SCAN-RAWDATA",IBD("IBDJ"),"FD1")),"FORMID=",2)
107 I +FORMID>0 D UNRECV(FORMID)
108 D RECV(.ALAN,.IBD)
109 W !! X "ZW ALAN W !! ZW PXCA"
110 K IBTEST
111 Q
Note: See TracBrowser for help on using the repository browser.