DGQEUT2 ;ALB/RPM - VIC REPLACEMENT UTILITIES #2 ; 3/13/06 11:12am
;;5.3;Registration;**571,641,679,1015**;Aug 13, 1993;Build 21
;
; This routine contains the following VIC Redesign API's:
; CPRSTAT - determine Card Print Release Status
; $$PENDDT - checks for pending requests and returns request date
; $$REQFLD - checks for required fields
; $$HOLD - checks for pending ICN and/or Enrollment
; $$VICELIG - determines applicant's VIC eligibility
;
Q ;no direct entry
;
;
CPRSTAT(DGVIC) ;determine card print release status
; This procedure is used to determine Card Print Release Status from
; the data contained in the input array (DGVIC). Once determined, the
; status and remarks are placed into the VIC data array.
;
; Input:
; DGVIC - VIC data array (pass by reference)
;
; Output: None
;
N DGERR
;
D ;drop out of DO block when DGVIC("STAT") is known
. ;
. ;check if DFN is valid
. ;set card print release status="C"ancel if not valid
. I '$D(^DPT(+$G(DGVIC("DFN")),0)) D
. . S DGVIC("STAT")="C"
. . S DGVIC("REMARKS")="Unable to find veteran in the database"
. Q:DGVIC("STAT")]""
. ;
. ;check for required fields
. ;set card print release status="C"ancel if req field is missing
. I '$$REQFLD(.DGVIC,.DGERR) D
. . S DGVIC("STAT")="C"
. . S DGVIC("REMARKS")=$G(DGERR)
. Q:DGVIC("STAT")]""
. ;
. ;check for pending conditions
. ;set card print release status="H"old if pending conditions exist
. I $$HOLD(.DGVIC,.DGERR) D
. . S DGVIC("STAT")="H"
. . S DGVIC("REMARKS")=$G(DGERR)
. Q:DGVIC("STAT")]""
. ;
. ;check if pt is eligible for VIC
. ;set card print release status="P"rint if eligible, else "I"neligible
. I $$VICELIG(.DGVIC) S DGVIC("STAT")="P"
. E D
. . S DGVIC("STAT")="I"
. . S DGVIC("REMARKS")="Veteran does not meet VIC eligibility requirements."
;
Q
;
;
PENDDT(DGDFN) ;check for pending request date
;
; Input:
; DGDFN - pointer to patient in PATIENT (#2) file
;
; Output:
; Function value - FM format request date on success, 0 on failure
;
N DGDAT ;function value
N DGRIEN ;VIC REQUEST pointer
N DGREQ ;array of request data
;
S DGDAT=0
;
;get last request
S DGRIEN=$$FINDLST^DGQEREQ(DGDFN)
I DGRIEN D
. Q:'$$GETREQ^DGQEREQ(DGRIEN,.DGREQ)
. ;
. ;check Card Print Release Status
. I $G(DGREQ("CPRSTAT"))="H" S DGDAT=+$G(DGREQ("REQDT"))
;
Q DGDAT
;
;
REQFLD(DGVIC,DGERR) ;required field check
; This function is used to check for required fields in the VIC data
; array.
;
; Input:
; DGVIC - VIC data array (pass by reference)
;
; Output:
; Function value - returns 1 on success, 0 on failure.
; DGERR - error msg returned on failure
;
N DGTYPE ;mailing address type
N DGSUB ;array subscript
;
D ;quit DO block on first error
. ;
. ;check for required SSN
. I $G(DGVIC("SSN"))="" S DGERR="Unable to determine veteran's Social Security Number"
. Q:$D(DGERR)
. ;
. ;check for required DOB to include month and day
. I +$G(DGVIC("DOB"))>0 D
. . I +$E(DGVIC("DOB"),1,2)<1!(+$E(DGVIC("DOB"),3,4)<1) S DGERR="Unable to determine veteran's complete Date of Birth"
. E S DGERR="Unable to determine veteran's Date of Birth"
. Q:$D(DGERR)
. ;
. ;check for required name components
. F DGSUB="NAME","LAST" D Q:$D(DGERR)
. . I $G(DGVIC(DGSUB))="" S DGERR="Unable to determine veteran's Name"
. . ;
. . ;prevent submission of incomplete patient merges
. . I DGSUB="NAME",DGVIC(DGSUB)["MERGING INTO" S DGERR="Incomplete patient record merge"
. Q:$D(DGERR)
. ;
. ;check for address selection type
. I '$G(DGVIC("ADRTYPE")) S DGERR="Unable to determine a mailing address"
. Q:$D(DGERR)
. ;
. ;check for required pt address components
. F DGSUB="STREET1","CITY","STATE","ZIP" D Q:$D(DGERR)
. . I $G(DGVIC(DGSUB))="" D
. . . S DGTYPE=$S(DGVIC("ADRTYPE")=1:"permanent",DGVIC("ADRTYPE")=2:"temporary",DGVIC("ADRTYPE")=3:"confidential",1:"facility")
. . . S DGERR="Unable to determine the "_DGSUB_" field of the "_DGTYPE_" mailing address"
. Q:$D(DGERR)
. ;
. ;check for required VIC eligibility factors
. F DGSUB="SC" D Q:$D(DGERR)
. . I $G(DGVIC(DGSUB))="" S DGERR="Unable to determine veteran's Service Connected Indicator"
. Q:$D(DGERR)
. ;
. ;check for required facility data elements
. F DGSUB="FACNUM","FACNAME","VISN" D Q:$D(DGERR)
. . I $G(DGVIC(DGSUB))="" S DGERR="Unable to determine a source facility"
;
Q $S($D(DGERR):0,1:1)
;
;
HOLD(DGVIC,DGMSG) ;check for pending ICN, Enrollment Status, Purple Heart
; This function checks for a pending ICN, Enrollment Status, and/or
; Purple Heart confirmation and builds the appropriate message text
; when a pending condition exists.
;
; Input:
; DGVIC - VIC data array, pass by reference
; Array subscripts are:
; "ICN" - integration control number
; Note: Must be in format returned by $$GETICN^DGQEDEMO
; "ENRSTAT" - enrollment status
; Note: Must be in format returned by $$STATUS^DGENA
; "PH" - purple heart status
; Note: Must be in format returned by $$GETPH^DGQEUT1
;
; Output:
; Function value - returns 1 when a pending condition exists;
; otherwise, returns 0
;
; DGMSG - Message text returned when function value=1 listing
; pending data items; pass by reference
;
N DGI ;generic index
N DGENRST ;enrollment status value
N DGCNT ;pending item count
N DGRSLT ;function value
;
S DGRSLT=0
S DGCNT=0
S DGENRST=+$G(DGVIC("ENRSTAT"))
;
;is national ICN missing
I '+$G(DGVIC("ICN")) D
. S DGRSLT=1
. S DGCNT=DGCNT+1
. S DGMSG(DGCNT)="Veteran does not have a National ICN"
;
;is enrollment status
I $$ISENRPND^DGQEUT1(DGENRST) D
. S DGRSLT=1
. S DGCNT=DGCNT+1
. S DGMSG(DGCNT)="Veteran is pending verification"
;
;is purple heart pending
I $G(DGVIC("PH"))="P" D
. S DGRSLT=1
. S DGCNT=DGCNT+1
. S DGMSG(DGCNT)="Veteran's Purple Heart status is pending confirmation"
;
;format message text
I DGCNT D
. S DGMSG=""
. F DGI=1:1:DGCNT S DGMSG=DGMSG_$S(DGI>1&(DGI<DGCNT):", ",DGI>1&(DGI=DGCNT):" and ",1:"")_DGMSG(DGI)
. S DGMSG=DGMSG_"."
;
Q DGRSLT
;
;
VICELIG(DGELG) ;is applicant eligible for a Veteran ID Card?
; This function determines if an applicant is eligible for a Veteran
; Identification Card (VIC).
;
; Input:
; DGELG - eligibility data object array
;
; Output:
; Function Value - returns 1 if the applicant is eligible for VIC,
; 0 if not eligible
;
N DGRSLT ;function result
;
;set default, not eligible
S DGRSLT=0
;
D ;apply VIC eligibilty rules
. I (DGELG("ENRSTAT")=2)!(DGELG("ENRSTAT")=21) S DGRSLT=1 Q
. ;
. I (DGELG("ENRSTAT")=7)!(DGELG("ENRSTAT")=19)!(DGELG("ENRSTAT")=20) D Q:DGRSLT
. . Q:DGELG("ELIGSTAT")'="V"
. . I DGELG("MST")="Y" S DGRSLT=1 Q
. . I DGELG("SC")=1 S DGRSLT=1 Q
. ;
. I (DGELG("ENRSTAT")=11)!(DGELG("ENRSTAT")=12)!(DGELG("ENRSTAT")=13)!(DGELG("ENRSTAT")=14)!(DGELG("ENRSTAT")=22) D Q:DGRSLT
. . Q:DGELG("ELIGSTAT")'="V"
. . I DGELG("COMBVET")=1 S DGRSLT=1 Q
. . I DGELG("SC")=1 S DGRSLT=1 Q
. . I DGELG("MST")="Y" S DGRSLT=1 Q
;
Q DGRSLT
DGQEUT2 ;ALB/RPM - VIC REPLACEMENT UTILITIES #2 ; 3/13/06 11:12am
+1 ;;5.3;Registration;**571,641,679,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ; This routine contains the following VIC Redesign API's:
+4 ; CPRSTAT - determine Card Print Release Status
+5 ; $$PENDDT - checks for pending requests and returns request date
+6 ; $$REQFLD - checks for required fields
+7 ; $$HOLD - checks for pending ICN and/or Enrollment
+8 ; $$VICELIG - determines applicant's VIC eligibility
+9 ;
+10 ;no direct entry
QUIT
+11 ;
+12 ;
CPRSTAT(DGVIC) ;determine card print release status
+1 ; This procedure is used to determine Card Print Release Status from
+2 ; the data contained in the input array (DGVIC). Once determined, the
+3 ; status and remarks are placed into the VIC data array.
+4 ;
+5 ; Input:
+6 ; DGVIC - VIC data array (pass by reference)
+7 ;
+8 ; Output: None
+9 ;
+10 NEW DGERR
+11 ;
+12 ;drop out of DO block when DGVIC("STAT") is known
Begin DoDot:1
+13 ;
+14 ;check if DFN is valid
+15 ;set card print release status="C"ancel if not valid
+16 IF '$DATA(^DPT(+$GET(DGVIC("DFN")),0))
Begin DoDot:2
+17 SET DGVIC("STAT")="C"
+18 SET DGVIC("REMARKS")="Unable to find veteran in the database"
End DoDot:2
+19 IF DGVIC("STAT")]""
QUIT
+20 ;
+21 ;check for required fields
+22 ;set card print release status="C"ancel if req field is missing
+23 IF '$$REQFLD(.DGVIC,.DGERR)
Begin DoDot:2
+24 SET DGVIC("STAT")="C"
+25 SET DGVIC("REMARKS")=$GET(DGERR)
End DoDot:2
+26 IF DGVIC("STAT")]""
QUIT
+27 ;
+28 ;check for pending conditions
+29 ;set card print release status="H"old if pending conditions exist
+30 IF $$HOLD(.DGVIC,.DGERR)
Begin DoDot:2
+31 SET DGVIC("STAT")="H"
+32 SET DGVIC("REMARKS")=$GET(DGERR)
End DoDot:2
+33 IF DGVIC("STAT")]""
QUIT
+34 ;
+35 ;check if pt is eligible for VIC
+36 ;set card print release status="P"rint if eligible, else "I"neligible
+37 IF $$VICELIG(.DGVIC)
SET DGVIC("STAT")="P"
+38 IF '$TEST
Begin DoDot:2
+39 SET DGVIC("STAT")="I"
+40 SET DGVIC("REMARKS")="Veteran does not meet VIC eligibility requirements."
End DoDot:2
End DoDot:1
+41 ;
+42 QUIT
+43 ;
+44 ;
PENDDT(DGDFN) ;check for pending request date
+1 ;
+2 ; Input:
+3 ; DGDFN - pointer to patient in PATIENT (#2) file
+4 ;
+5 ; Output:
+6 ; Function value - FM format request date on success, 0 on failure
+7 ;
+8 ;function value
NEW DGDAT
+9 ;VIC REQUEST pointer
NEW DGRIEN
+10 ;array of request data
NEW DGREQ
+11 ;
+12 SET DGDAT=0
+13 ;
+14 ;get last request
+15 SET DGRIEN=$$FINDLST^DGQEREQ(DGDFN)
+16 IF DGRIEN
Begin DoDot:1
+17 IF '$$GETREQ^DGQEREQ(DGRIEN,.DGREQ)
QUIT
+18 ;
+19 ;check Card Print Release Status
+20 IF $GET(DGREQ("CPRSTAT"))="H"
SET DGDAT=+$GET(DGREQ("REQDT"))
End DoDot:1
+21 ;
+22 QUIT DGDAT
+23 ;
+24 ;
REQFLD(DGVIC,DGERR) ;required field check
+1 ; This function is used to check for required fields in the VIC data
+2 ; array.
+3 ;
+4 ; Input:
+5 ; DGVIC - VIC data array (pass by reference)
+6 ;
+7 ; Output:
+8 ; Function value - returns 1 on success, 0 on failure.
+9 ; DGERR - error msg returned on failure
+10 ;
+11 ;mailing address type
NEW DGTYPE
+12 ;array subscript
NEW DGSUB
+13 ;
+14 ;quit DO block on first error
Begin DoDot:1
+15 ;
+16 ;check for required SSN
+17 IF $GET(DGVIC("SSN"))=""
SET DGERR="Unable to determine veteran's Social Security Number"
+18 IF $DATA(DGERR)
QUIT
+19 ;
+20 ;check for required DOB to include month and day
+21 IF +$GET(DGVIC("DOB"))>0
Begin DoDot:2
+22 IF +$EXTRACT(DGVIC("DOB"),1,2)<1!(+$EXTRACT(DGVIC("DOB"),3,4)<1)
SET DGERR="Unable to determine veteran's complete Date of Birth"
End DoDot:2
+23 IF '$TEST
SET DGERR="Unable to determine veteran's Date of Birth"
+24 IF $DATA(DGERR)
QUIT
+25 ;
+26 ;check for required name components
+27 FOR DGSUB="NAME","LAST"
Begin DoDot:2
+28 IF $GET(DGVIC(DGSUB))=""
SET DGERR="Unable to determine veteran's Name"
+29 ;
+30 ;prevent submission of incomplete patient merges
+31 IF DGSUB="NAME"
IF DGVIC(DGSUB)["MERGING INTO"
SET DGERR="Incomplete patient record merge"
End DoDot:2
IF $DATA(DGERR)
QUIT
+32 IF $DATA(DGERR)
QUIT
+33 ;
+34 ;check for address selection type
+35 IF '$GET(DGVIC("ADRTYPE"))
SET DGERR="Unable to determine a mailing address"
+36 IF $DATA(DGERR)
QUIT
+37 ;
+38 ;check for required pt address components
+39 FOR DGSUB="STREET1","CITY","STATE","ZIP"
Begin DoDot:2
+40 IF $GET(DGVIC(DGSUB))=""
Begin DoDot:3
+41 SET DGTYPE=$SELECT(DGVIC("ADRTYPE")=1:"permanent",DGVIC("ADRTYPE")=2:"temporary",DGVIC("ADRTYPE")=3:"confidential",1:"facility")
+42 SET DGERR="Unable to determine the "_DGSUB_" field of the "_DGTYPE_" mailing address"
End DoDot:3
End DoDot:2
IF $DATA(DGERR)
QUIT
+43 IF $DATA(DGERR)
QUIT
+44 ;
+45 ;check for required VIC eligibility factors
+46 FOR DGSUB="SC"
Begin DoDot:2
+47 IF $GET(DGVIC(DGSUB))=""
SET DGERR="Unable to determine veteran's Service Connected Indicator"
End DoDot:2
IF $DATA(DGERR)
QUIT
+48 IF $DATA(DGERR)
QUIT
+49 ;
+50 ;check for required facility data elements
+51 FOR DGSUB="FACNUM","FACNAME","VISN"
Begin DoDot:2
+52 IF $GET(DGVIC(DGSUB))=""
SET DGERR="Unable to determine a source facility"
End DoDot:2
IF $DATA(DGERR)
QUIT
End DoDot:1
+53 ;
+54 QUIT $SELECT($DATA(DGERR):0,1:1)
+55 ;
+56 ;
HOLD(DGVIC,DGMSG) ;check for pending ICN, Enrollment Status, Purple Heart
+1 ; This function checks for a pending ICN, Enrollment Status, and/or
+2 ; Purple Heart confirmation and builds the appropriate message text
+3 ; when a pending condition exists.
+4 ;
+5 ; Input:
+6 ; DGVIC - VIC data array, pass by reference
+7 ; Array subscripts are:
+8 ; "ICN" - integration control number
+9 ; Note: Must be in format returned by $$GETICN^DGQEDEMO
+10 ; "ENRSTAT" - enrollment status
+11 ; Note: Must be in format returned by $$STATUS^DGENA
+12 ; "PH" - purple heart status
+13 ; Note: Must be in format returned by $$GETPH^DGQEUT1
+14 ;
+15 ; Output:
+16 ; Function value - returns 1 when a pending condition exists;
+17 ; otherwise, returns 0
+18 ;
+19 ; DGMSG - Message text returned when function value=1 listing
+20 ; pending data items; pass by reference
+21 ;
+22 ;generic index
NEW DGI
+23 ;enrollment status value
NEW DGENRST
+24 ;pending item count
NEW DGCNT
+25 ;function value
NEW DGRSLT
+26 ;
+27 SET DGRSLT=0
+28 SET DGCNT=0
+29 SET DGENRST=+$GET(DGVIC("ENRSTAT"))
+30 ;
+31 ;is national ICN missing
+32 IF '+$GET(DGVIC("ICN"))
Begin DoDot:1
+33 SET DGRSLT=1
+34 SET DGCNT=DGCNT+1
+35 SET DGMSG(DGCNT)="Veteran does not have a National ICN"
End DoDot:1
+36 ;
+37 ;is enrollment status
+38 IF $$ISENRPND^DGQEUT1(DGENRST)
Begin DoDot:1
+39 SET DGRSLT=1
+40 SET DGCNT=DGCNT+1
+41 SET DGMSG(DGCNT)="Veteran is pending verification"
End DoDot:1
+42 ;
+43 ;is purple heart pending
+44 IF $GET(DGVIC("PH"))="P"
Begin DoDot:1
+45 SET DGRSLT=1
+46 SET DGCNT=DGCNT+1
+47 SET DGMSG(DGCNT)="Veteran's Purple Heart status is pending confirmation"
End DoDot:1
+48 ;
+49 ;format message text
+50 IF DGCNT
Begin DoDot:1
+51 SET DGMSG=""
+52 FOR DGI=1:1:DGCNT
SET DGMSG=DGMSG_$SELECT(DGI>1&(DGI<DGCNT):", ",DGI>1&(DGI=DGCNT):" and ",1:"")_DGMSG(DGI)
+53 SET DGMSG=DGMSG_"."
End DoDot:1
+54 ;
+55 QUIT DGRSLT
+56 ;
+57 ;
VICELIG(DGELG) ;is applicant eligible for a Veteran ID Card?
+1 ; This function determines if an applicant is eligible for a Veteran
+2 ; Identification Card (VIC).
+3 ;
+4 ; Input:
+5 ; DGELG - eligibility data object array
+6 ;
+7 ; Output:
+8 ; Function Value - returns 1 if the applicant is eligible for VIC,
+9 ; 0 if not eligible
+10 ;
+11 ;function result
NEW DGRSLT
+12 ;
+13 ;set default, not eligible
+14 SET DGRSLT=0
+15 ;
+16 ;apply VIC eligibilty rules
Begin DoDot:1
+17 IF (DGELG("ENRSTAT")=2)!(DGELG("ENRSTAT")=21)
SET DGRSLT=1
QUIT
+18 ;
+19 IF (DGELG("ENRSTAT")=7)!(DGELG("ENRSTAT")=19)!(DGELG("ENRSTAT")=20)
Begin DoDot:2
+20 IF DGELG("ELIGSTAT")'="V"
QUIT
+21 IF DGELG("MST")="Y"
SET DGRSLT=1
QUIT
+22 IF DGELG("SC")=1
SET DGRSLT=1
QUIT
End DoDot:2
IF DGRSLT
QUIT
+23 ;
+24 IF (DGELG("ENRSTAT")=11)!(DGELG("ENRSTAT")=12)!(DGELG("ENRSTAT")=13)!(DGELG("ENRSTAT")=14)!(DGELG("ENRSTAT")=22)
Begin DoDot:2
+25 IF DGELG("ELIGSTAT")'="V"
QUIT
+26 IF DGELG("COMBVET")=1
SET DGRSLT=1
QUIT
+27 IF DGELG("SC")=1
SET DGRSLT=1
QUIT
+28 IF DGELG("MST")="Y"
SET DGRSLT=1
QUIT
End DoDot:2
IF DGRSLT
QUIT
End DoDot:1
+29 ;
+30 QUIT DGRSLT
