- 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 Jan 18, 2025@03:43:23 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