| [613] | 1 | VAQDBIP4 ;ALB/JRP - MAS (REGISTRATION) INFO EXTRACTION;22-MAR-93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|---|
| 3 | MASXTRCT(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
|
|---|
