1 | VAQPAR10 ;ALB/JRP - MESSAGE PARSING;07-MAY-93
|
---|
2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
---|
3 | PARCON ;CONTINUATION FOR PARSE10^VAQPAR1
|
---|
4 | ; DECLARATIONS DONE IN CALLING ROUTINE
|
---|
5 | ;
|
---|
6 | ;MAKE USER BLOCK
|
---|
7 | S @ARRAY@(2,"USER",1,1)="$USER"
|
---|
8 | S TMP=$G(@ARRAY@(1,"HEADER",1))
|
---|
9 | I ((TYPE="RES")!(TYPE="UNS")) D
|
---|
10 | .S @ARRAY@(2,"USER",1,2)=$P(TMP,"^",15)
|
---|
11 | .S @ARRAY@(2,"USER",1,3)=$P(TMP,"^",14)
|
---|
12 | .S X=+$P(TMP,"^",16)
|
---|
13 | I (TYPE="REQ") D
|
---|
14 | .S @ARRAY@(2,"USER",1,2)=$P(TMP,"^",8)
|
---|
15 | .S @ARRAY@(2,"USER",1,3)=$P(TMP,"^",7)
|
---|
16 | .S X=+$P(TMP,"^",10)
|
---|
17 | S TMP=+$O(^DIC(4,"D",X,""))
|
---|
18 | S Y="UNKNOWN"
|
---|
19 | S:(TMP) Y=$P($G(^DIC(4,TMP,0)),"^",1)
|
---|
20 | S @ARRAY@(2,"USER",1,4)=Y
|
---|
21 | S @ARRAY@(2,"USER",1,5)="$$USER"
|
---|
22 | ;MAKE PATIENT BLOCK
|
---|
23 | S TMP=$G(@ARRAY@(1,"HEADER",1))
|
---|
24 | S @ARRAY@(2,"PATIENT",1,1)="$PATIENT"
|
---|
25 | S @ARRAY@(2,"PATIENT",1,2)=0
|
---|
26 | S @ARRAY@(2,"PATIENT",1,3)=$P(TMP,"^",2)
|
---|
27 | S X=$P(TMP,"^",6)
|
---|
28 | I (X="") S Y=$P(TMP,"^",3),X=$$DASHSSN^VAQUTL99(Y)
|
---|
29 | S @ARRAY@(2,"PATIENT",1,4)=X
|
---|
30 | S X=$P(TMP,"^",3)
|
---|
31 | S Y=$$DASHSSN^VAQUTL99(X)
|
---|
32 | S @ARRAY@(2,"PATIENT",1,5)=Y
|
---|
33 | S X=$P(TMP,"^",5)
|
---|
34 | S Y=$$DATE^VAQUTL99(X)
|
---|
35 | S:(Y=-1) Y=""
|
---|
36 | S X=$$DOBFMT^VAQUTL99(Y)
|
---|
37 | S @ARRAY@(2,"PATIENT",1,6)=X
|
---|
38 | S @ARRAY@(2,"PATIENT",1,7)=""
|
---|
39 | S @ARRAY@(2,"PATIENT",1,8)=""
|
---|
40 | S @ARRAY@(2,"PATIENT",1,9)="$$PATIENT"
|
---|
41 | ;MAKE SEGMENT BLOCK
|
---|
42 | S @ARRAY@(2,"SEGMENT",1,1)="$SEGMENT"
|
---|
43 | S @ARRAY@(2,"SEGMENT",1,2)="PDX*MAS"
|
---|
44 | S @ARRAY@(2,"SEGMENT",1,3)=""
|
---|
45 | S @ARRAY@(2,"SEGMENT",1,4)=""
|
---|
46 | S @ARRAY@(2,"SEGMENT",1,5)="PDX*MIN"
|
---|
47 | S @ARRAY@(2,"SEGMENT",1,6)=""
|
---|
48 | S @ARRAY@(2,"SEGMENT",1,7)=""
|
---|
49 | S @ARRAY@(2,"SEGMENT",1,8)="PDX*MPL"
|
---|
50 | S @ARRAY@(2,"SEGMENT",1,9)=""
|
---|
51 | S @ARRAY@(2,"SEGMENT",1,10)=""
|
---|
52 | S @ARRAY@(2,"SEGMENT",1,11)="$$SEGMENT"
|
---|
53 | ;DONE IF REQUEST
|
---|
54 | Q:(TYPE="REQ")
|
---|
55 | ;MAKE COMMENT
|
---|
56 | S @ARRAY@(2,"COMMENT",1,1)="$COMMENT"
|
---|
57 | S TMP=$G(@ARRAY@(1,"HEADER",2))
|
---|
58 | S X=$P(TMP,"^",2)
|
---|
59 | S TMP=$G(@ARRAY@(1,"HEADER",1))
|
---|
60 | S:((+$P(TMP,"^",12))=18) X="Patient was not registered"
|
---|
61 | S:(STATUS="VAQ-AMBIG") X="Patient could not be uniquely identified"
|
---|
62 | S:(STATUS="VAQ-NTFND") X="Patient was not found"
|
---|
63 | S @ARRAY@(2,"COMMENT",1,2)=X
|
---|
64 | S @ARRAY@(2,"COMMENT",1,3)="$$COMMENT"
|
---|
65 | ;DONE IF RESULTS DID NOT CONTAIN DATA
|
---|
66 | Q:((TYPE="RES")&(STATUS'="VAQ-RSLT"))
|
---|
67 | ;MAKE DATA BLOCK FOR MINIMUM DATA
|
---|
68 | D DATA10^VAQPAR11(ARRAY,"MIN",1)
|
---|
69 | Q:(XMER<0)
|
---|
70 | ;MAKE DATA BLOCK FOR MAS DATA
|
---|
71 | D DATA10^VAQPAR11(ARRAY,"MAS",2)
|
---|
72 | Q:(XMER<0)
|
---|
73 | ;MAKE DATA BLOCK FOR PHARMACY DATA
|
---|
74 | D DATA10^VAQPAR11(ARRAY,"PHA",3)
|
---|
75 | Q:(XMER<0)
|
---|
76 | Q
|
---|