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