source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENELA2.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 928 bytes
Line 
1DGENELA2 ;ALB/CJM - Patient Eligibility API ; 13 JUN 1997
2 ;;5.3;Registration;**147**;08/13/93
3 ;
4DELELIG(DFN,DGELG) ;
5 ;Description: Deletes eligibilities from the patient file Patient
6 ;Eligibilities multiple that are not contained in DGELG() array.
7 ;
8 ;Input:
9 ; DFN - ien of Patient record
10 ; DGELG() - eligibility array (pass by reference)
11 ;Output: none
12 ;
13 N DIK,DA,CODE
14 S DA(1)=DFN
15 S DIK="^DPT("_DFN_",""E"","
16 S DA=0 F S DA=$O(^DPT(DFN,"E",DA)) Q:'DA D
17 .S CODE=+$G(^DPT(DFN,"E",DA,0))
18 .;
19 .;don't delete if it belongs
20 .Q:$D(DGELG("ELIG","CODE",CODE))
21 .;
22 .;don't delete if it's the primary eligibility code
23 .Q:(CODE=DGELG("ELIG","CODE"))
24 .D ^DIK
25 Q
26 ;
27DELRDIS(DFN) ;
28 ;Description: deletes Rated Disability multiple from the patient file
29 ;
30 ;Input:
31 ; DFN - ien of Patient record
32 ;Output: none
33 ;
34 N DIK,DA
35 S DA(1)=DFN
36 S DIK="^DPT("_DFN_",.372,"
37 S DA=0 F S DA=$O(^DPT(DFN,.372,DA)) Q:'DA D ^DIK
38 Q
Note: See TracBrowser for help on using the repository browser.