| 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 | 
|---|