source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQFIL15.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

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