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