[613] | 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
|
---|