DGQEUT1 ;ALB/RPM - VIC REPLACEMENT UTILITIES #1 ; 10/03/05
;;5.3;Registration;**571,679,732,1015**;Aug 13, 1993;Build 21
;
; This routine contains the following VIC Redesign API's:
; INITARR - initialize data array
; $$GETPAT - build Patient data array
; $$GETELIG - build Patient Eligibility data array
; $$GETPH - determine Purple Heart status
; $$GETPOW - determine Prisoner of War status
; $$FNDPOW - search for Prisoner of War eligibility code
; $$ISENRPND - is enrollment status pending
;
Q ;no direct entry
;
INITARR(DGVIC) ;Procedure used to initialize VIC data array nodes.
;
; Input:
; none
;
; Output:
; DGVIC - array of VIC data (pass by reference)
;
N DGSUB ;array subscript
;
;init patient identifier nodes
S DGVIC("DFN")=""
F DGSUB="NAME","SSN","DOB","LAST","FIRST","MIDDLE","SUFFIX","PREFIX" D
. S DGVIC(DGSUB)=""
;
;init address nodes
F DGSUB="STREET1","STREET2","STREET3","CITY","STATE","ZIP","ADRTYPE" D
. S DGVIC(DGSUB)=""
;
;init vic eligibility nodes
F DGSUB="SC","ENRSTAT","ELIGSTAT","MST","COMBVET","POW","PH" D
. S DGVIC(DGSUB)=""
;
;init facility nodes
F DGSUB="FACNUM","FACNAME","VISN" D
. S DGVIC(DGSUB)=""
;
;init card print release status node
S DGVIC("STAT")=""
;
;init document type node
S DGVIC("DOCTYPE")="VIC"
;
Q
;
;
GETPAT(DGDFN,DGPAT) ;build Patient object
; This function retrieves patient demographic data needed to produce
; a Veteran ID Card and returns the data in an array format.
;
; Supported Reference:
; DBIA #10103: $$FMTE^XLFDT
;
; Input:
; DGDFN - (required) pointer to patient in PATIENT (#2) file
;
; Output:
; Function value - returns 1 on success, 0 on failure
; DGPAT - array of patient demographics, pass by reference
; Array subscripts are:
; "DFN" - Pointer to patient in PATIENT (#2) file
; "NAME" - Patient Full Name
; "SSN" - Social Security Number
; "DOB" - Date of Birth (mmddyyyy)
; "LAST" - Family Name from name components
; "FIRST" - Given Name from name components
; "MIDDLE" - Middle Name from name components
; "SUFFIX" - Suffix from name components
; "PREFIX" - Prefix from name components
; "STREET1" - Line 1 of mailing address
; "STREET2" - Line 2 of mailing address
; "STREET3" - Line 3 of mailing address
; "CITY" - Mailing address city
; "STATE" - Mailing address state
; "ZIP" - Mailing address ZIP code
; "ADRTYPE" - Mailing address type
; [0:unable to determine,1:permanent,
; 2:temporary,3:confidential,4:facility]
; "ICN" - Integration Control Number
; "FACNUM" - Local Station number
; "FACNAME" - Local Facility name
; "VISN" - Local Facility's VISN
;
N DGRSLT
;
S DGRSLT=0
;
I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D ;drop out of block on first failure
. ;
. ;get name, ssn, dob, dfn
. Q:'$$GETIDS^DGQEDEMO(DGDFN,.DGPAT)
. ;
. ;format Date of Birth to mmddyyyy
. S DGPAT("DOB")=$TR($$FMTE^XLFDT(DGPAT("DOB"),"5Z"),"/","")
. ;
. ;get name components
. Q:'$$GETNAMC^DGQEDEMO(DGDFN,.DGPAT)
. ;
. ;get mailing address
. Q:'$$GETADDR^DGQEDEMO(DGDFN,.DGPAT)
. ;
. ;get national ICN
. S DGPAT("ICN")=$$GETICN^DGQEDEMO(DGDFN)
. ;
. ;get facility info
. D GETSITE^DGQEDEMO(.DGPAT)
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
;
GETELIG(DGDFN,DGELG) ;build Patient Eligibility object
; This function retrieves patient data needed to determine the
; patient's VIC eligibility and returns the data in an array format.
;
; Supported References:
; DBIA #10061: ELIG^VADPT
; DBIA #2716: $$GETSTAT^DGMSTAPI
; DBIA #4156: $$CVEDT^DGCV
;
; Input:
; DGDFN - (required) pointer to patient in PATIENT (#2) file
;
; Output:
; Function value - returns 1 on success, 0 on failure
; DGELG - array of eligibility indicators, pass by reference
; Array subscripts are:
; "SC" - Service Connected indicator
; "ENRSTAT" - Enrollment Status
; "ELIGSTAT" - Eligibility Status
; "MST" - Military Sexual Trauma Status
; "COMBVET" - Combat Veteran Status
; "POW" - Prisoner of War Indicator
; "PH" - Purple Heart Indicator
;
N DFN ;input parameter to ELIG^VADPT
N DGRSLT ;function value
N VAEL ;VADPT return array
N VAERR ;VADPT error value
;
S DGRSLT=0
;
I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
. ;
. ;get Eligibility Status and Service Connection
. S DFN=DGDFN
. D ELIG^VADPT
. S DGELG("ELIGSTAT")=$P($G(VAEL(8)),U)
. S DGELG("SC")=+$G(VAEL(3))
. ;
. ;get current Enrollment Status
. S DGELG("ENRSTAT")=$$STATUS^DGENA(DGDFN)
. ;
. ;get MST Status
. S DGELG("MST")=$P($$GETSTAT^DGMSTAPI(DGDFN),U,2)
. ;
. ;get Combat Veteran Status
. S DGELG("COMBVET")=+$$CVEDT^DGCV(DGDFN)
. ;
. ;get Purple Heart Indicator
. S DGELG("PH")=$$GETPH(DGDFN)
. ;
. ;get POW indicator
. S DGELG("POW")=$S($$ISENRPND(DGELG("ENRSTAT")):"P",1:$$FNDPOW(.VAEL))
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
;
GETPH(DGDFN) ;get purple heart indicator
;This function retrieves the Current PH Indicator and Current PH
;Status and returns a single interpretation value.
;
; Supported References:
; DBIA #10061: SVC^VADPT
;
; Input:
; DGDFN - pointer to patient in PATIENT (#2) file
;
; Output:
; Function value - returns "Y" to print indicator on VIC; "N" to
; not print indicator on VIC; "P" to hold request
; until confirmation; "" when Registration interview
; question is unanswered.
;
N DFN ;input parameter to SVC^VADPT
N DGPHIND ;current purple heart indicator
N DGPHSTAT ;current purple heart status
N DGRSLT ;function value
N VAERR ;VADPT error value
N VASV ;VADPT return array
;
S DGRSLT=""
;
I $G(DGDFN)>0,$D(^DPT(DGDFN)) D
. ;
. ;get purple heart indicator and status
. S DFN=DGDFN
. D SVC^VADPT
. S DGPHIND=$G(VASV(9))
. S DGPHSTAT=$P($G(VASV(9,1)),U,2)
. ;
. ;interpret status
. I DGPHIND=1 S DGRSLT=$S(DGPHSTAT="CONFIRMED":"Y",1:"P")
. I DGPHIND=0 S DGRSLT="N"
;
Q DGRSLT
;
GETPOW(DGDFN) ;get POW indicator
;This function retrieves the eligibility codes for a given patient and
;returns the POW indicator.
;
; Supported References:
; DBIA #10061: ELIG^VADPT
;
; Input:
; DGDFN - pointer to patient in PATIENT (#2) file
;
; Output:
; Function value - returns results from call to $$FNDPOW
;
N DFN
N VAEL ;VADPT result array
N VAERR ;VADPT error message
;
S DFN=$G(DGDFN)
D ELIG^VADPT
;
Q $$FNDPOW(.VAEL)
;
FNDPOW(DGEL) ;find POW eligibility code
;This function searches a list of eligibility codes for PRISONER OF
;WAR and returns the boolean result.
;
; Input:
; DGEL - result array from call to ELIG^VADPT
;
; Output:
; Function value - returns "Y" when PRISONER OF WAR found;
; otherwise "N"
;
N DGEC ;eligibility code number
N DGRSLT ;function value
;
S DGRSLT="N"
;
;Check primary eligibility code
I $P($G(DGEL(1)),U,2)="PRISONER OF WAR" Q "Y"
;
S DGEC=0
F S DGEC=$O(DGEL(1,DGEC)) Q:'DGEC D Q:DGRSLT="Y"
. I $P(DGEL(1,DGEC),U,2)="PRISONER OF WAR" S DGRSLT="Y"
;
Q DGRSLT
;
ISENRPND(DGST) ;is veteran's enrollment status pending?
;
; Input:
; DGST - pointer to enrollment status in ENROLLMENT STATUS (#27.15)
; file.
;
; Output:
; Function value - returns 1 when status is pending; otherwise 0
;
S DGST=+$G(DGST)
Q $S('DGST:1,DGST=1:1,DGST=15:1,DGST=16:1,DGST=17:1,DGST=18:1,1:0)
DGQEUT1 ;ALB/RPM - VIC REPLACEMENT UTILITIES #1 ; 10/03/05
+1 ;;5.3;Registration;**571,679,732,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ; This routine contains the following VIC Redesign API's:
+4 ; INITARR - initialize data array
+5 ; $$GETPAT - build Patient data array
+6 ; $$GETELIG - build Patient Eligibility data array
+7 ; $$GETPH - determine Purple Heart status
+8 ; $$GETPOW - determine Prisoner of War status
+9 ; $$FNDPOW - search for Prisoner of War eligibility code
+10 ; $$ISENRPND - is enrollment status pending
+11 ;
+12 ;no direct entry
QUIT
+13 ;
INITARR(DGVIC) ;Procedure used to initialize VIC data array nodes.
+1 ;
+2 ; Input:
+3 ; none
+4 ;
+5 ; Output:
+6 ; DGVIC - array of VIC data (pass by reference)
+7 ;
+8 ;array subscript
NEW DGSUB
+9 ;
+10 ;init patient identifier nodes
+11 SET DGVIC("DFN")=""
+12 FOR DGSUB="NAME","SSN","DOB","LAST","FIRST","MIDDLE","SUFFIX","PREFIX"
Begin DoDot:1
+13 SET DGVIC(DGSUB)=""
End DoDot:1
+14 ;
+15 ;init address nodes
+16 FOR DGSUB="STREET1","STREET2","STREET3","CITY","STATE","ZIP","ADRTYPE"
Begin DoDot:1
+17 SET DGVIC(DGSUB)=""
End DoDot:1
+18 ;
+19 ;init vic eligibility nodes
+20 FOR DGSUB="SC","ENRSTAT","ELIGSTAT","MST","COMBVET","POW","PH"
Begin DoDot:1
+21 SET DGVIC(DGSUB)=""
End DoDot:1
+22 ;
+23 ;init facility nodes
+24 FOR DGSUB="FACNUM","FACNAME","VISN"
Begin DoDot:1
+25 SET DGVIC(DGSUB)=""
End DoDot:1
+26 ;
+27 ;init card print release status node
+28 SET DGVIC("STAT")=""
+29 ;
+30 ;init document type node
+31 SET DGVIC("DOCTYPE")="VIC"
+32 ;
+33 QUIT
+34 ;
+35 ;
GETPAT(DGDFN,DGPAT) ;build Patient object
+1 ; This function retrieves patient demographic data needed to produce
+2 ; a Veteran ID Card and returns the data in an array format.
+3 ;
+4 ; Supported Reference:
+5 ; DBIA #10103: $$FMTE^XLFDT
+6 ;
+7 ; Input:
+8 ; DGDFN - (required) pointer to patient in PATIENT (#2) file
+9 ;
+10 ; Output:
+11 ; Function value - returns 1 on success, 0 on failure
+12 ; DGPAT - array of patient demographics, pass by reference
+13 ; Array subscripts are:
+14 ; "DFN" - Pointer to patient in PATIENT (#2) file
+15 ; "NAME" - Patient Full Name
+16 ; "SSN" - Social Security Number
+17 ; "DOB" - Date of Birth (mmddyyyy)
+18 ; "LAST" - Family Name from name components
+19 ; "FIRST" - Given Name from name components
+20 ; "MIDDLE" - Middle Name from name components
+21 ; "SUFFIX" - Suffix from name components
+22 ; "PREFIX" - Prefix from name components
+23 ; "STREET1" - Line 1 of mailing address
+24 ; "STREET2" - Line 2 of mailing address
+25 ; "STREET3" - Line 3 of mailing address
+26 ; "CITY" - Mailing address city
+27 ; "STATE" - Mailing address state
+28 ; "ZIP" - Mailing address ZIP code
+29 ; "ADRTYPE" - Mailing address type
+30 ; [0:unable to determine,1:permanent,
+31 ; 2:temporary,3:confidential,4:facility]
+32 ; "ICN" - Integration Control Number
+33 ; "FACNUM" - Local Station number
+34 ; "FACNAME" - Local Facility name
+35 ; "VISN" - Local Facility's VISN
+36 ;
+37 NEW DGRSLT
+38 ;
+39 SET DGRSLT=0
+40 ;
+41 ;drop out of block on first failure
IF $GET(DGDFN)>0
IF $DATA(^DPT(DGDFN,0))
Begin DoDot:1
+42 ;
+43 ;get name, ssn, dob, dfn
+44 IF '$$GETIDS^DGQEDEMO(DGDFN,.DGPAT)
QUIT
+45 ;
+46 ;format Date of Birth to mmddyyyy
+47 SET DGPAT("DOB")=$TRANSLATE($$FMTE^XLFDT(DGPAT("DOB"),"5Z"),"/","")
+48 ;
+49 ;get name components
+50 IF '$$GETNAMC^DGQEDEMO(DGDFN,.DGPAT)
QUIT
+51 ;
+52 ;get mailing address
+53 IF '$$GETADDR^DGQEDEMO(DGDFN,.DGPAT)
QUIT
+54 ;
+55 ;get national ICN
+56 SET DGPAT("ICN")=$$GETICN^DGQEDEMO(DGDFN)
+57 ;
+58 ;get facility info
+59 DO GETSITE^DGQEDEMO(.DGPAT)
+60 ;
+61 ;success
+62 SET DGRSLT=1
End DoDot:1
+63 ;
+64 QUIT DGRSLT
+65 ;
GETELIG(DGDFN,DGELG) ;build Patient Eligibility object
+1 ; This function retrieves patient data needed to determine the
+2 ; patient's VIC eligibility and returns the data in an array format.
+3 ;
+4 ; Supported References:
+5 ; DBIA #10061: ELIG^VADPT
+6 ; DBIA #2716: $$GETSTAT^DGMSTAPI
+7 ; DBIA #4156: $$CVEDT^DGCV
+8 ;
+9 ; Input:
+10 ; DGDFN - (required) pointer to patient in PATIENT (#2) file
+11 ;
+12 ; Output:
+13 ; Function value - returns 1 on success, 0 on failure
+14 ; DGELG - array of eligibility indicators, pass by reference
+15 ; Array subscripts are:
+16 ; "SC" - Service Connected indicator
+17 ; "ENRSTAT" - Enrollment Status
+18 ; "ELIGSTAT" - Eligibility Status
+19 ; "MST" - Military Sexual Trauma Status
+20 ; "COMBVET" - Combat Veteran Status
+21 ; "POW" - Prisoner of War Indicator
+22 ; "PH" - Purple Heart Indicator
+23 ;
+24 ;input parameter to ELIG^VADPT
NEW DFN
+25 ;function value
NEW DGRSLT
+26 ;VADPT return array
NEW VAEL
+27 ;VADPT error value
NEW VAERR
+28 ;
+29 SET DGRSLT=0
+30 ;
+31 IF $GET(DGDFN)>0
IF $DATA(^DPT(DGDFN,0))
Begin DoDot:1
+32 ;
+33 ;get Eligibility Status and Service Connection
+34 SET DFN=DGDFN
+35 DO ELIG^VADPT
+36 SET DGELG("ELIGSTAT")=$PIECE($GET(VAEL(8)),U)
+37 SET DGELG("SC")=+$GET(VAEL(3))
+38 ;
+39 ;get current Enrollment Status
+40 SET DGELG("ENRSTAT")=$$STATUS^DGENA(DGDFN)
+41 ;
+42 ;get MST Status
+43 SET DGELG("MST")=$PIECE($$GETSTAT^DGMSTAPI(DGDFN),U,2)
+44 ;
+45 ;get Combat Veteran Status
+46 SET DGELG("COMBVET")=+$$CVEDT^DGCV(DGDFN)
+47 ;
+48 ;get Purple Heart Indicator
+49 SET DGELG("PH")=$$GETPH(DGDFN)
+50 ;
+51 ;get POW indicator
+52 SET DGELG("POW")=$SELECT($$ISENRPND(DGELG("ENRSTAT")):"P",1:$$FNDPOW(.VAEL))
+53 ;
+54 ;success
+55 SET DGRSLT=1
End DoDot:1
+56 ;
+57 QUIT DGRSLT
+58 ;
GETPH(DGDFN) ;get purple heart indicator
+1 ;This function retrieves the Current PH Indicator and Current PH
+2 ;Status and returns a single interpretation value.
+3 ;
+4 ; Supported References:
+5 ; DBIA #10061: SVC^VADPT
+6 ;
+7 ; Input:
+8 ; DGDFN - pointer to patient in PATIENT (#2) file
+9 ;
+10 ; Output:
+11 ; Function value - returns "Y" to print indicator on VIC; "N" to
+12 ; not print indicator on VIC; "P" to hold request
+13 ; until confirmation; "" when Registration interview
+14 ; question is unanswered.
+15 ;
+16 ;input parameter to SVC^VADPT
NEW DFN
+17 ;current purple heart indicator
NEW DGPHIND
+18 ;current purple heart status
NEW DGPHSTAT
+19 ;function value
NEW DGRSLT
+20 ;VADPT error value
NEW VAERR
+21 ;VADPT return array
NEW VASV
+22 ;
+23 SET DGRSLT=""
+24 ;
+25 IF $GET(DGDFN)>0
IF $DATA(^DPT(DGDFN))
Begin DoDot:1
+26 ;
+27 ;get purple heart indicator and status
+28 SET DFN=DGDFN
+29 DO SVC^VADPT
+30 SET DGPHIND=$GET(VASV(9))
+31 SET DGPHSTAT=$PIECE($GET(VASV(9,1)),U,2)
+32 ;
+33 ;interpret status
+34 IF DGPHIND=1
SET DGRSLT=$SELECT(DGPHSTAT="CONFIRMED":"Y",1:"P")
+35 IF DGPHIND=0
SET DGRSLT="N"
End DoDot:1
+36 ;
+37 QUIT DGRSLT
+38 ;
GETPOW(DGDFN) ;get POW indicator
+1 ;This function retrieves the eligibility codes for a given patient and
+2 ;returns the POW indicator.
+3 ;
+4 ; Supported References:
+5 ; DBIA #10061: ELIG^VADPT
+6 ;
+7 ; Input:
+8 ; DGDFN - pointer to patient in PATIENT (#2) file
+9 ;
+10 ; Output:
+11 ; Function value - returns results from call to $$FNDPOW
+12 ;
+13 NEW DFN
+14 ;VADPT result array
NEW VAEL
+15 ;VADPT error message
NEW VAERR
+16 ;
+17 SET DFN=$GET(DGDFN)
+18 DO ELIG^VADPT
+19 ;
+20 QUIT $$FNDPOW(.VAEL)
+21 ;
FNDPOW(DGEL) ;find POW eligibility code
+1 ;This function searches a list of eligibility codes for PRISONER OF
+2 ;WAR and returns the boolean result.
+3 ;
+4 ; Input:
+5 ; DGEL - result array from call to ELIG^VADPT
+6 ;
+7 ; Output:
+8 ; Function value - returns "Y" when PRISONER OF WAR found;
+9 ; otherwise "N"
+10 ;
+11 ;eligibility code number
NEW DGEC
+12 ;function value
NEW DGRSLT
+13 ;
+14 SET DGRSLT="N"
+15 ;
+16 ;Check primary eligibility code
+17 IF $PIECE($GET(DGEL(1)),U,2)="PRISONER OF WAR"
QUIT "Y"
+18 ;
+19 SET DGEC=0
+20 FOR
SET DGEC=$ORDER(DGEL(1,DGEC))
IF 'DGEC
QUIT
Begin DoDot:1
+21 IF $PIECE(DGEL(1,DGEC),U,2)="PRISONER OF WAR"
SET DGRSLT="Y"
End DoDot:1
IF DGRSLT="Y"
QUIT
+22 ;
+23 QUIT DGRSLT
+24 ;
ISENRPND(DGST) ;is veteran's enrollment status pending?
+1 ;
+2 ; Input:
+3 ; DGST - pointer to enrollment status in ENROLLMENT STATUS (#27.15)
+4 ; file.
+5 ;
+6 ; Output:
+7 ; Function value - returns 1 when status is pending; otherwise 0
+8 ;
+9 SET DGST=+$GET(DGST)
+10 QUIT $SELECT('DGST:1,DGST=1:1,DGST=15:1,DGST=16:1,DGST=17:1,DGST=18:1,1:0)
