source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECDP1.m@ 623

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1EASECDP1 ;ALB/LBD List One Dependent/Edit Effective Dates ;22 AUG 2001
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7**;Mar 15, 2001
3 ;
4LSTDEP(DGDEP) ;List Depentdents
5 N DEP,CNT S CNT=0
6 F S CNT=$O(DGDEP(CNT)) Q:'CNT D ONE(CNT)
7 Q
8 ;
9ONE(CNT) ; List one dependent
10 ;
11 N DGLN S DGLN=1
12 ;
13 S X="",X=$$SETSTR^VALM1("SSN: ",X,4,5)
14 S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,5),X,9,24)
15 S X=$$SETSTR^VALM1("Sex: ",X,52,5)
16 S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,3),X,58,7)
17 D SET(X)
18 ;
19 S X="",X=$$SETSTR^VALM1("DOB: ",X,4,5)
20 S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,4),X,9,24)
21 D SET(X)
22 ;
23 S DEP=""
24 F S DEP=$O(DGDEP(CNT,DEP)) Q:DEP']"" D
25 .S X="",X=$$SETSTR^VALM1("Status: ",X,1,8)
26 .S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U,2),X,9,24)
27 .S X=$$SETSTR^VALM1("Effective Date: ",X,41,16)
28 .S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U),X,58,20)
29 .D SET(X)
30 .D SET("")
31 S VALMCNT=DGLN-1
32 Q
33 ;
34SET(X) ;Set up array
35 S ^TMP("DGMTEP",$J,DGLN,0)=X
36 S DGLN=DGLN+1
37 Q
38 ;
39EXIT ;
40 K ^TMP("DGMTEP",$J)
41 Q
42 ;
43EN ; Effective Dates
44 S VALMBCK=""
45 I $D(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay test." H 2 G ENQ
46 I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G ENQ
47 D EDIT
48 I DGW=1 D I $G(DGERR) W !,"Cannot inactivate veteran" K DGERR G EN
49 .S DATE=$O(DGDEP(1,""))
50 .S ACTIVE=$P(DGDEP(1,DATE),U,2)
51 .I ACTIVE="Inactive" S DGERR=1
52ENQ S VALMBCK="R"
53 Q
54 ;
55EDIT ; Edit Effective Dates
56 ; values for DGFLG:
57 ; DGFLG = 1 IVM effective date
58 ;
59 N DA,DR,DIE,DIC,DATE,DGEDIT,DGEE,Y
60 S DGFLG=0,DGEDIT=1
61 S DGPR=$S($G(DGW):$P(DGDEP(DGW),U,20),1:$P(DGDEP,U,20))
62 S DIE="^DGPR(408.12,",DA=DGPR,DR="75"
63 S DR(2,408.1275)="I $P($G(^DGPR(408.12,DGPR,""E"",DA,0)),U,3) S Y=0,DGFLG=1;S:$P($G(^DGPR(408.12,DGPR,""E"",DA,0)),U,2)']"""" DIE(""NO^"")="""";.01;.02"
64 D ^DIE
65 I DGFLG W !!,"Cannot edit date added by IVM." H 2 G EDITQ
66 S DATE=0,DATE=$O(^DGPR(408.12,$P(DGDEP(DGW),U,20),"E",DATE))
67 I 'DATE W !!,"There has to be an effective date for this person." H 2 G EDIT
68EDITQ K DGDEP,DGFLG D INIT^EASECDEP
69 K ^TMP("DGMTEP",$J) D ONE(DGW)
70 Q
71 ;
72DOB(DA,X) ;CHECK EFFECTIVE DATE AGAINST DOB
73 N DGFILE,X1
74 S DGFILE=$P($G(^DGPR(408.12,DA,0)),U,3),X1=$P(DGFILE,";"),DGFILE=$S(DGFILE["DGPR":"^DGPR(408.13,",1:"^DPT(")
75 I X<$P($G(@(DGFILE_X1_",0)")),U,3) D
76 . W !," <<EFFECTIVE DATE may not precede Date Of Birth>>",$C(7)
77 . S X=0
78 Q X
Note: See TracBrowser for help on using the repository browser.