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 Dec 13, 2024@02:25:50 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
