77 lines
2.3 KiB
Mathematica
77 lines
2.3 KiB
Mathematica
VAQPAR10 ;ALB/JRP - MESSAGE PARSING;07-MAY-93
|
|
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|
PARCON ;CONTINUATION FOR PARSE10^VAQPAR1
|
|
; DECLARATIONS DONE IN CALLING ROUTINE
|
|
;
|
|
;MAKE USER BLOCK
|
|
S @ARRAY@(2,"USER",1,1)="$USER"
|
|
S TMP=$G(@ARRAY@(1,"HEADER",1))
|
|
I ((TYPE="RES")!(TYPE="UNS")) D
|
|
.S @ARRAY@(2,"USER",1,2)=$P(TMP,"^",15)
|
|
.S @ARRAY@(2,"USER",1,3)=$P(TMP,"^",14)
|
|
.S X=+$P(TMP,"^",16)
|
|
I (TYPE="REQ") D
|
|
.S @ARRAY@(2,"USER",1,2)=$P(TMP,"^",8)
|
|
.S @ARRAY@(2,"USER",1,3)=$P(TMP,"^",7)
|
|
.S X=+$P(TMP,"^",10)
|
|
S TMP=+$O(^DIC(4,"D",X,""))
|
|
S Y="UNKNOWN"
|
|
S:(TMP) Y=$P($G(^DIC(4,TMP,0)),"^",1)
|
|
S @ARRAY@(2,"USER",1,4)=Y
|
|
S @ARRAY@(2,"USER",1,5)="$$USER"
|
|
;MAKE PATIENT BLOCK
|
|
S TMP=$G(@ARRAY@(1,"HEADER",1))
|
|
S @ARRAY@(2,"PATIENT",1,1)="$PATIENT"
|
|
S @ARRAY@(2,"PATIENT",1,2)=0
|
|
S @ARRAY@(2,"PATIENT",1,3)=$P(TMP,"^",2)
|
|
S X=$P(TMP,"^",6)
|
|
I (X="") S Y=$P(TMP,"^",3),X=$$DASHSSN^VAQUTL99(Y)
|
|
S @ARRAY@(2,"PATIENT",1,4)=X
|
|
S X=$P(TMP,"^",3)
|
|
S Y=$$DASHSSN^VAQUTL99(X)
|
|
S @ARRAY@(2,"PATIENT",1,5)=Y
|
|
S X=$P(TMP,"^",5)
|
|
S Y=$$DATE^VAQUTL99(X)
|
|
S:(Y=-1) Y=""
|
|
S X=$$DOBFMT^VAQUTL99(Y)
|
|
S @ARRAY@(2,"PATIENT",1,6)=X
|
|
S @ARRAY@(2,"PATIENT",1,7)=""
|
|
S @ARRAY@(2,"PATIENT",1,8)=""
|
|
S @ARRAY@(2,"PATIENT",1,9)="$$PATIENT"
|
|
;MAKE SEGMENT BLOCK
|
|
S @ARRAY@(2,"SEGMENT",1,1)="$SEGMENT"
|
|
S @ARRAY@(2,"SEGMENT",1,2)="PDX*MAS"
|
|
S @ARRAY@(2,"SEGMENT",1,3)=""
|
|
S @ARRAY@(2,"SEGMENT",1,4)=""
|
|
S @ARRAY@(2,"SEGMENT",1,5)="PDX*MIN"
|
|
S @ARRAY@(2,"SEGMENT",1,6)=""
|
|
S @ARRAY@(2,"SEGMENT",1,7)=""
|
|
S @ARRAY@(2,"SEGMENT",1,8)="PDX*MPL"
|
|
S @ARRAY@(2,"SEGMENT",1,9)=""
|
|
S @ARRAY@(2,"SEGMENT",1,10)=""
|
|
S @ARRAY@(2,"SEGMENT",1,11)="$$SEGMENT"
|
|
;DONE IF REQUEST
|
|
Q:(TYPE="REQ")
|
|
;MAKE COMMENT
|
|
S @ARRAY@(2,"COMMENT",1,1)="$COMMENT"
|
|
S TMP=$G(@ARRAY@(1,"HEADER",2))
|
|
S X=$P(TMP,"^",2)
|
|
S TMP=$G(@ARRAY@(1,"HEADER",1))
|
|
S:((+$P(TMP,"^",12))=18) X="Patient was not registered"
|
|
S:(STATUS="VAQ-AMBIG") X="Patient could not be uniquely identified"
|
|
S:(STATUS="VAQ-NTFND") X="Patient was not found"
|
|
S @ARRAY@(2,"COMMENT",1,2)=X
|
|
S @ARRAY@(2,"COMMENT",1,3)="$$COMMENT"
|
|
;DONE IF RESULTS DID NOT CONTAIN DATA
|
|
Q:((TYPE="RES")&(STATUS'="VAQ-RSLT"))
|
|
;MAKE DATA BLOCK FOR MINIMUM DATA
|
|
D DATA10^VAQPAR11(ARRAY,"MIN",1)
|
|
Q:(XMER<0)
|
|
;MAKE DATA BLOCK FOR MAS DATA
|
|
D DATA10^VAQPAR11(ARRAY,"MAS",2)
|
|
Q:(XMER<0)
|
|
;MAKE DATA BLOCK FOR PHARMACY DATA
|
|
D DATA10^VAQPAR11(ARRAY,"PHA",3)
|
|
Q:(XMER<0)
|
|
Q
|