- VAQFIL15 ;ALB/JRP - MESSAGE FILING;12-MAY-93
- ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
- PATIENT(MESSNUM,PARSARR,TRANPTR) ;FILE PATIENT BLOCK
- ;INPUT : MESSNUM - Message number in transmission (not XMZ)
- ; (defaults to 1)
- ; PARSARR - Parsing array (full global reference)
- ; TRANPTR - Pointer to VAQ - TRANSACTION file
- ; (As defined by MailMan)
- ; XMFROM, XMREC,XMZ
- ;OUTPUT : 0 - Success
- ; -1^Error_Text - Error
- ;NOTES : It is the responsibility of the calling program to correct
- ; the transaction being updated if an error occurs.
- ;
- ;CHECK INPUT
- S:($G(MESSNUM)="") MESSNUM=1
- Q:($G(PARSARR)="") "-1^Did not pass reference to parsing array"
- Q:('$D(@PARSARR@(MESSNUM))) "-1^Did not pass valid message number"
- Q:('$D(@PARSARR@(MESSNUM,"PATIENT",1))) "-1^Message did not contain a patient block"
- S TRANPTR=+$G(TRANPTR)
- Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid transaction"
- ;DECLARE VARIABLES
- N TMP,ERR,STRING,KEY1,KEY2,DECSTR,NAME,PID,SSN,DOB
- N SENSITVE,ENCRYPT,DECRYPT,TYPE
- ;MAKE SURE IT'S A PATIENT BLOCK
- S TMP=$G(@PARSARR@(MESSNUM,"PATIENT",1,1))
- S:(TMP=" ") TMP=""
- Q:((TMP="")!(TMP'="$PATIENT")) "-1^Not a patient block"
- S TMP=$G(@PARSARR@(MESSNUM,"PATIENT",1,9))
- S:(TMP=" ") TMP=""
- Q:((TMP="")!(TMP'="$$PATIENT")) "-1^Not a valid patient block"
- ;GET MESSAGE TYPE
- S TMP=$$STATYPE^VAQFIL11(MESSNUM,PARSARR)
- Q:($P(TMP,"^",1)="-1") "-1^Could not determine message type"
- S TYPE=$P(TMP,"^",2)
- ;ACK & RETRANSMIT DON'T HAVE PATIENT BLOCK
- Q:((TYPE="ACK")!(TYPE="RET")) "-1^Message type does not require patient block"
- ;GET ENCRYPTION FLAG
- S ENCRYPT=+$G(@PARSARR@(MESSNUM,"PATIENT",1,2))
- ;SET UP DECRYPTION CALL
- S DECRYPT=$$DECMTHD^VAQFIL11(MESSNUM,PARSARR,2)
- Q:((ENCRYPT)&(DECRYPT="")) "-1^Encryption method not contained in header block"
- S:(ENCRYPT) DECRYPT=("S DECSTR="_DECRYPT)
- S:('ENCRYPT) DECRYPT="S DECSTR=STRING"
- ;GET KEYS
- S KEY1=$$KEY^VAQFIL13(MESSNUM,PARSARR,1)
- S KEY2=$$KEY^VAQFIL13(MESSNUM,PARSARR,0)
- Q:((ENCRYPT)&((KEY1="")!(KEY2=""))) "-1^Could not determine decryption keys"
- ;GET NAME
- S STRING=$G(@PARSARR@(MESSNUM,"PATIENT",1,3))
- S:(STRING=" ") STRING=""
- X DECRYPT
- S NAME=DECSTR
- ;GET PID
- S STRING=$G(@PARSARR@(MESSNUM,"PATIENT",1,4))
- S:(STRING=" ") STRING=""
- X DECRYPT
- S PID=DECSTR
- ;GET SSN (REMOVE DASHES)
- S STRING=$G(@PARSARR@(MESSNUM,"PATIENT",1,5))
- S:(STRING=" ") STRING=""
- X DECRYPT
- S SSN=$TR(DECSTR,"-","")
- ;GET DOB
- S STRING=$G(@PARSARR@(MESSNUM,"PATIENT",1,6))
- S:(STRING=" ") STRING=""
- X DECRYPT
- S DOB=DECSTR
- ;CONVERT IMPRECISE DATES TO ACCEPTIBLE FORMAT (IF REQUIRED)
- S DOB=$$IMPDTE^VAQUTL95(DOB)
- S:(DOB="-1") DOB=""
- ;GET SENSITIVITY FLAG
- S STRING=$G(@PARSARR@(MESSNUM,"PATIENT",1,8))
- S:(STRING=" ") STRING=""
- X DECRYPT
- S SENSITVE=$S((+DECSTR):"YES",1:"NO")
- ;MAKE SURE SOME PATIENT IDENTIFICATION WAS PASSED
- Q:((NAME="")&(PID="")&(SSN="")) "Identity of patient not contained in patient block"
- ;ONLY STORE PATIENT DEFINITION WHEN NOT RESULTS
- I (TYPE'="RES") D Q:(ERR) ERR
- .S ERR=0
- .I $$FILEINFO^VAQFILE(394.61,TRANPTR,10,NAME) S ERR="-1^Could not file patient's name ("_NAME_")" Q
- .I $$FILEINFO^VAQFILE(394.61,TRANPTR,13,PID) S ERR="-1^Could not file patient's PID ("_PID_")" Q
- .I $$FILEINFO^VAQFILE(394.61,TRANPTR,11,SSN) S ERR="-1^Could not file patient's SSN ("_SSN_")" Q
- .I $$FILEINFO^VAQFILE(394.61,TRANPTR,12,DOB) S ERR="-1^Could not file patient's date of birth ("_DOB_")" Q
- .S ERR=0
- ;STORE REMOTE SENSITIVITY
- S ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,.04,SENSITVE)
- Q:(ERR) "-1^Could not file patient's sensitivity ("_SENSITVE_")"
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQFIL15 3727 printed Feb 18, 2025@23:51:53 Page 2
- VAQFIL15 ;ALB/JRP - MESSAGE FILING;12-MAY-93
- +1 ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
- PATIENT(MESSNUM,PARSARR,TRANPTR) ;FILE PATIENT BLOCK
- +1 ;INPUT : MESSNUM - Message number in transmission (not XMZ)
- +2 ; (defaults to 1)
- +3 ; PARSARR - Parsing array (full global reference)
- +4 ; TRANPTR - Pointer to VAQ - TRANSACTION file
- +5 ; (As defined by MailMan)
- +6 ; XMFROM, XMREC,XMZ
- +7 ;OUTPUT : 0 - Success
- +8 ; -1^Error_Text - Error
- +9 ;NOTES : It is the responsibility of the calling program to correct
- +10 ; the transaction being updated if an error occurs.
- +11 ;
- +12 ;CHECK INPUT
- +13 if ($GET(MESSNUM)="")
- SET MESSNUM=1
- +14 if ($GET(PARSARR)="")
- QUIT "-1^Did not pass reference to parsing array"
- +15 if ('$DATA(@PARSARR@(MESSNUM)))
- QUIT "-1^Did not pass valid message number"
- +16 if ('$DATA(@PARSARR@(MESSNUM,"PATIENT",1)))
- QUIT "-1^Message did not contain a patient block"
- +17 SET TRANPTR=+$GET(TRANPTR)
- +18 if (('TRANPTR)!('$DATA(^VAT(394.61,TRANPTR))))
- QUIT "-1^Did not pass a valid transaction"
- +19 ;DECLARE VARIABLES
- +20 NEW TMP,ERR,STRING,KEY1,KEY2,DECSTR,NAME,PID,SSN,DOB
- +21 NEW SENSITVE,ENCRYPT,DECRYPT,TYPE
- +22 ;MAKE SURE IT'S A PATIENT BLOCK
- +23 SET TMP=$GET(@PARSARR@(MESSNUM,"PATIENT",1,1))
- +24 if (TMP=" ")
- SET TMP=""
- +25 if ((TMP="")!(TMP'="$PATIENT"))
- QUIT "-1^Not a patient block"
- +26 SET TMP=$GET(@PARSARR@(MESSNUM,"PATIENT",1,9))
- +27 if (TMP=" ")
- SET TMP=""
- +28 if ((TMP="")!(TMP'="$$PATIENT"))
- QUIT "-1^Not a valid patient block"
- +29 ;GET MESSAGE TYPE
- +30 SET TMP=$$STATYPE^VAQFIL11(MESSNUM,PARSARR)
- +31 if ($PIECE(TMP,"^",1)="-1")
- QUIT "-1^Could not determine message type"
- +32 SET TYPE=$PIECE(TMP,"^",2)
- +33 ;ACK & RETRANSMIT DON'T HAVE PATIENT BLOCK
- +34 if ((TYPE="ACK")!(TYPE="RET"))
- QUIT "-1^Message type does not require patient block"
- +35 ;GET ENCRYPTION FLAG
- +36 SET ENCRYPT=+$GET(@PARSARR@(MESSNUM,"PATIENT",1,2))
- +37 ;SET UP DECRYPTION CALL
- +38 SET DECRYPT=$$DECMTHD^VAQFIL11(MESSNUM,PARSARR,2)
- +39 if ((ENCRYPT)&(DECRYPT=""))
- QUIT "-1^Encryption method not contained in header block"
- +40 if (ENCRYPT)
- SET DECRYPT=("S DECSTR="_DECRYPT)
- +41 if ('ENCRYPT)
- SET DECRYPT="S DECSTR=STRING"
- +42 ;GET KEYS
- +43 SET KEY1=$$KEY^VAQFIL13(MESSNUM,PARSARR,1)
- +44 SET KEY2=$$KEY^VAQFIL13(MESSNUM,PARSARR,0)
- +45 if ((ENCRYPT)&((KEY1="")!(KEY2="")))
- QUIT "-1^Could not determine decryption keys"
- +46 ;GET NAME
- +47 SET STRING=$GET(@PARSARR@(MESSNUM,"PATIENT",1,3))
- +48 if (STRING=" ")
- SET STRING=""
- +49 XECUTE DECRYPT
- +50 SET NAME=DECSTR
- +51 ;GET PID
- +52 SET STRING=$GET(@PARSARR@(MESSNUM,"PATIENT",1,4))
- +53 if (STRING=" ")
- SET STRING=""
- +54 XECUTE DECRYPT
- +55 SET PID=DECSTR
- +56 ;GET SSN (REMOVE DASHES)
- +57 SET STRING=$GET(@PARSARR@(MESSNUM,"PATIENT",1,5))
- +58 if (STRING=" ")
- SET STRING=""
- +59 XECUTE DECRYPT
- +60 SET SSN=$TRANSLATE(DECSTR,"-","")
- +61 ;GET DOB
- +62 SET STRING=$GET(@PARSARR@(MESSNUM,"PATIENT",1,6))
- +63 if (STRING=" ")
- SET STRING=""
- +64 XECUTE DECRYPT
- +65 SET DOB=DECSTR
- +66 ;CONVERT IMPRECISE DATES TO ACCEPTIBLE FORMAT (IF REQUIRED)
- +67 SET DOB=$$IMPDTE^VAQUTL95(DOB)
- +68 if (DOB="-1")
- SET DOB=""
- +69 ;GET SENSITIVITY FLAG
- +70 SET STRING=$GET(@PARSARR@(MESSNUM,"PATIENT",1,8))
- +71 if (STRING=" ")
- SET STRING=""
- +72 XECUTE DECRYPT
- +73 SET SENSITVE=$SELECT((+DECSTR):"YES",1:"NO")
- +74 ;MAKE SURE SOME PATIENT IDENTIFICATION WAS PASSED
- +75 if ((NAME="")&(PID="")&(SSN=""))
- QUIT "Identity of patient not contained in patient block"
- +76 ;ONLY STORE PATIENT DEFINITION WHEN NOT RESULTS
- +77 IF (TYPE'="RES")
- Begin DoDot:1
- +78 SET ERR=0
- +79 IF $$FILEINFO^VAQFILE(394.61,TRANPTR,10,NAME)
- SET ERR="-1^Could not file patient's name ("_NAME_")"
- QUIT
- +80 IF $$FILEINFO^VAQFILE(394.61,TRANPTR,13,PID)
- SET ERR="-1^Could not file patient's PID ("_PID_")"
- QUIT
- +81 IF $$FILEINFO^VAQFILE(394.61,TRANPTR,11,SSN)
- SET ERR="-1^Could not file patient's SSN ("_SSN_")"
- QUIT
- +82 IF $$FILEINFO^VAQFILE(394.61,TRANPTR,12,DOB)
- SET ERR="-1^Could not file patient's date of birth ("_DOB_")"
- QUIT
- +83 SET ERR=0
- End DoDot:1
- if (ERR)
- QUIT ERR
- +84 ;STORE REMOTE SENSITIVITY
- +85 SET ERR=$$FILEINFO^VAQFILE(394.61,TRANPTR,.04,SENSITVE)
- +86 if (ERR)
- QUIT "-1^Could not file patient's sensitivity ("_SENSITVE_")"
- +87 QUIT 0