source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDBIP4.m@ 789

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1VAQDBIP4 ;ALB/JRP - MAS (REGISTRATION) INFO EXTRACTION;22-MAR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3MASXTRCT(TRAN,DFN,ARRAY) ;EXTRACT MAS (REGISTRATION) INFO (EXTRACTION ARRAY)
4 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
5 ; DFN - Pointer to patient in PATIENT file
6 ; ARRAY - Where to store information (full global reference)
7 ;OUTPUT : 0 - Extraction was successful
8 ; -1^Error_Text - Extraction was not successful
9 ;NOTES : If the MAS (Registration) information can not be extracted,
10 ; the "VALUE" and "ID" nodes in ARRAY will be deleted.
11 ; : If TRAN is passed
12 ; The patient pointer of the transaction will be used
13 ; Encryption will be based on the transaction
14 ; If DFN is passed
15 ; Encryption will be based on the site parameter
16 ; : Pointer to transaction takes precedence over DFN ... if
17 ; TRAN>0 the DFN will be based on the transaction
18 ;
19 ;CHECK INPUT
20 S TRAN=+$G(TRAN)
21 S DFN=+$G(DFN)
22 Q:(('TRAN)&('DFN)) "-1^Did not pass pointer to transaction or patient"
23 I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
24 I (TRAN) S DFN=+$P($G(^VAT(394.61,TRAN,0)),"^",3) Q:('DFN) "-1^Transaction did not contain pointer to PATIENT file"
25 Q:('$D(^DPT(DFN))) "-1^Did not pass valid pointer to PATIENT file"
26 Q:($G(ARRAY)="") "-1^Did not pass output array"
27 ;DECLARE VARIABLES
28 N ERROR,TMP,LOOP,DIC,DA,DR,DIQ,FLDS,SEQ,X,Y,Z,NAME
29 N ENCRYPT,ENCSTR,KEY1,KEY2,STRING,PRIME,ENCPTR,SENDER
30 S ERROR=0
31 ;DETERMINE IF ENCRYPTION IS ON - SAVE POINTER TO ENCRYPTION METHOD
32 S:('TRAN) ENCPTR=$$NCRYPTON^VAQUTL2(0)
33 S:(TRAN) ENCPTR=$$TRANENC^VAQUTL3(TRAN,1)
34 ;SET UP EXECUTABLE CALL TO ENCRYPT
35 S:(ENCPTR) ENCRYPT=$$ENCMTHD^VAQUTL2(ENCPTR,0)
36 S:('ENCPTR) ENCRYPT=""
37 S:(ENCRYPT'="") ENCRYPT=("S ENCSTR="_ENCRYPT)
38 S:(ENCRYPT="") ENCRYPT="S ENCSTR=STRING"
39 ;DETERMINE PRIMARY KEY
40 I (TRAN) S SENDER=$$SENDER^VAQCON2(TRAN) Q:($P(SENDER,"^",1)="-1") "-1^Could not determine encryption keys"
41 S:(TRAN) SENDER=$P(SENDER,"^",1)
42 S:(TRAN) KEY1=$$NAMEKEY^VAQUTL3(SENDER,1)
43 S:('TRAN) KEY1=$$DUZKEY^VAQUTL3($G(DUZ),1)
44 ;DETERMINE SECONDARY KEY
45 S:(TRAN) KEY2=$$NAMEKEY^VAQUTL3(SENDER,0)
46 S:('TRAN) KEY2=$$DUZKEY^VAQUTL3($G(DUZ),0)
47 I (ENCPTR) Q:((KEY1="")!(KEY2="")) "-1^Could not determine encryption keys"
48 ;EXTRACT INFORMATION
49 F LOOP=1:1 D Q:(ERROR)
50 .S TMP=$T(MAS+LOOP^VAQDBII1)
51 .I ($P(TMP,";;",2)="") S ERROR=1 Q
52 .S ERROR=$$XTRCT^VAQDBIP2(TMP,DFN,"",ARRAY,ENCPTR,KEY1,KEY2)
53 .I ERROR D Q
54 ..S TMP=$$KILLARR^VAQUTL1(ARRAY,"VALUE")
55 ..S TMP=$$KILLARR^VAQUTL1(ARRAY,"ID")
56 Q:(ERROR<0) ERROR
57 ;EXTRACT OTHER ELIGIBILITIES
58 D ELIG^VAQDBIP6
59 ;EXTRACT APPOINTMENTS
60 D APPOINT^VAQDBIP6
61 ;EXTRACT DENTAL APPOINTMENTS
62 D DENTAL^VAQDBIP6
63 ;EXTRACT ACTIVE INSURANCES
64 D INSURE^VAQDBIP7
65 Q 0
Note: See TracBrowser for help on using the repository browser.