- 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 Apr 23, 2025@18:40:09 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
