Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGQEUT1

DGQEUT1.m

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