DGENELA2 ;ALB/CJM,ERC,JAM - Patient Eligibility API ; 13 JUN 1997
;;5.3;Registration;**147,688,1064**;Aug 13,1993;Build 41
;
DELELIG(DFN,DGELG) ;
;Description: Deletes eligibilities from the patient file Patient
;Eligibilities multiple that are not contained in DGELG() array.
;
;Input:
; DFN - ien of Patient record
; DGELG() - eligibility array (pass by reference)
;Output: none
;
N DIK,DA,CODE
S DA(1)=DFN
S DIK="^DPT("_DFN_",""E"","
S DA=0 F S DA=$O(^DPT(DFN,"E",DA)) Q:'DA D
.S CODE=+$G(^DPT(DFN,"E",DA,0))
.;
.;don't delete if it belongs
.Q:$D(DGELG("ELIG","CODE",CODE))
.;
.;don't delete if it's the primary eligibility code
.Q:(CODE=DGELG("ELIG","CODE"))
.D ^DIK
Q
;
DELRDIS(DFN) ;
;Description: deletes Rated Disability multiple from the patient file
;
;Input:
; DFN - ien of Patient record
;Output: none
;
N DIK,DA
S DA(1)=DFN
S DIK="^DPT("_DFN_",.372,"
S DA=0 F S DA=$O(^DPT(DFN,.372,DA)) Q:'DA D ^DIK
Q
UPDZ11 ;update the VistA Patient file record with data
;from the incoming Z11
;
;call moved from STORE^DGENELA1
I '$$UPD^DGENDBS(2,DFN,.DATA) S ERROR="FILEMAN FAILED TO UPDATE THE PATIENT RECORD" Q
;
;check P&T and P&T Effective Date - the date field has a
;lower field number if gets updated first. And if the P&T was 'N' or
;null and the date field is set, the date field will be deleted by
;the trigger cross reference on P&T
N DATA3013
I $G(DATA(.304))="Y",($G(DATA(.3013))]""),($P($G(^DPT(DFN,.3)),U,13)'=DATA(.3013)) D
. S DATA3013(.3013)=DATA(.3013)
. I '$$UPD^DGENDBS(2,DFN,.DATA3013) S ERROR="FILEMAN FAILED TO UPDATE P&T EFFECTIVE DATE" Q
Q
INDSTATUS(DFN) ; Returns Indian copay status for a patient
; jam; this tag added for Patch DG*5.3*1064
; Input: DFN - patient DFN
; Returns: 1 - (TRUE) if INDIAN SELF IDENTIFICATION field (#.571) equals YES,
; and the patient's ENROLLMENT STATUS is equal to VERIFIED.
;
I '$G(DFN) Q 0
I $$ENROLLED^DGENA(DFN)&($$GET1^DIQ(2,DFN_",",.571,"E")="YES") Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENELA2 2075 printed Dec 13, 2024@02:42:42 Page 2
DGENELA2 ;ALB/CJM,ERC,JAM - Patient Eligibility API ; 13 JUN 1997
+1 ;;5.3;Registration;**147,688,1064**;Aug 13,1993;Build 41
+2 ;
DELELIG(DFN,DGELG) ;
+1 ;Description: Deletes eligibilities from the patient file Patient
+2 ;Eligibilities multiple that are not contained in DGELG() array.
+3 ;
+4 ;Input:
+5 ; DFN - ien of Patient record
+6 ; DGELG() - eligibility array (pass by reference)
+7 ;Output: none
+8 ;
+9 NEW DIK,DA,CODE
+10 SET DA(1)=DFN
+11 SET DIK="^DPT("_DFN_",""E"","
+12 SET DA=0
FOR
SET DA=$ORDER(^DPT(DFN,"E",DA))
if 'DA
QUIT
Begin DoDot:1
+13 SET CODE=+$GET(^DPT(DFN,"E",DA,0))
+14 ;
+15 ;don't delete if it belongs
+16 if $DATA(DGELG("ELIG","CODE",CODE))
QUIT
+17 ;
+18 ;don't delete if it's the primary eligibility code
+19 if (CODE=DGELG("ELIG","CODE"))
QUIT
+20 DO ^DIK
End DoDot:1
+21 QUIT
+22 ;
DELRDIS(DFN) ;
+1 ;Description: deletes Rated Disability multiple from the patient file
+2 ;
+3 ;Input:
+4 ; DFN - ien of Patient record
+5 ;Output: none
+6 ;
+7 NEW DIK,DA
+8 SET DA(1)=DFN
+9 SET DIK="^DPT("_DFN_",.372,"
+10 SET DA=0
FOR
SET DA=$ORDER(^DPT(DFN,.372,DA))
if 'DA
QUIT
DO ^DIK
+11 QUIT
UPDZ11 ;update the VistA Patient file record with data
+1 ;from the incoming Z11
+2 ;
+3 ;call moved from STORE^DGENELA1
+4 IF '$$UPD^DGENDBS(2,DFN,.DATA)
SET ERROR="FILEMAN FAILED TO UPDATE THE PATIENT RECORD"
QUIT
+5 ;
+6 ;check P&T and P&T Effective Date - the date field has a
+7 ;lower field number if gets updated first. And if the P&T was 'N' or
+8 ;null and the date field is set, the date field will be deleted by
+9 ;the trigger cross reference on P&T
+10 NEW DATA3013
+11 IF $GET(DATA(.304))="Y"
IF ($GET(DATA(.3013))]"")
IF ($PIECE($GET(^DPT(DFN,.3)),U,13)'=DATA(.3013))
Begin DoDot:1
+12 SET DATA3013(.3013)=DATA(.3013)
+13 IF '$$UPD^DGENDBS(2,DFN,.DATA3013)
SET ERROR="FILEMAN FAILED TO UPDATE P&T EFFECTIVE DATE"
QUIT
End DoDot:1
+14 QUIT
INDSTATUS(DFN) ; Returns Indian copay status for a patient
+1 ; jam; this tag added for Patch DG*5.3*1064
+2 ; Input: DFN - patient DFN
+3 ; Returns: 1 - (TRUE) if INDIAN SELF IDENTIFICATION field (#.571) equals YES,
+4 ; and the patient's ENROLLMENT STATUS is equal to VERIFIED.
+5 ;
+6 IF '$GET(DFN)
QUIT 0
+7 IF $$ENROLLED^DGENA(DFN)&($$GET1^DIQ(2,DFN_",",.571,"E")="YES")
QUIT 1
+8 QUIT 0
