close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGLOCK2.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGLOCK2.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: 4.1 KB
RevLine 
1DGLOCK2 ;ALB/MRL - PATIENT FILE DATA EDIT CHECKS ; 28 Jan 2002 2:37 PM
2 ;;5.3;Registration;**18,244,624**;Aug 13, 1993
3K1 ;NOK Add
4 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
5 I $S('$D(^DPT(DFN,.21)):1,$P(^(.21),U,1)']"":1,1:0) W !?4,*7,"'NEXT OF KIN' name must be specified to enter/edit this field" K X
6 Q
7K1D ;NOK Delete
8 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
9 I $D(^DPT(DFN,.21)),$P(^(.21),U,1)]"" W !?4,*7,"Can't be deleted as long as 'NEXT OF KIN' is specified" K X
10 Q
11K2 ;NOK2 Add
12 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
13 D K1 I $D(X),$S('$D(^DPT(DFN,.211)):1,$P(^(.211),U,1)']"":1,1:0) W !?4,*7,"'NEXT OF KIN-2' name must be specified to enter/edit this field" K X
14 Q
15K2D ;NOK2 Delete
16 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
17 I $D(^DPT(DFN,.211)),$P(^(.211),U,1)]"" W !?4,*7,"Can't be deleted as long as 'NEXT OF KIN-2' is specified" K X
18 Q
19E1 ;Emer Add
20 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
21 I $S('$D(^DPT(DFN,.33)):1,$P(^(.33),U,1)']"":1,1:0) W !?4,*7,"'EMERGENCY CONTACT' name must be specified to enter/edit this field" K X
22 Q
23E1D ;Emer Delete
24 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
25 I $D(^DPT(DFN,.33)),$P(^(.33),U,1)]"" W !?4,*7,"Can't be deleted as long as 'EMERGENCY CONTACT' is specified" K X
26 Q
27E2 ;Emer2 Add
28 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
29 D E1 I $D(X),$S('$D(^DPT(DFN,.331)):1,$P(^(.331),U,1)']"":1,1:0) W !?4,*7,"'EMERGENCY CONTACT-2' name must be specified to enter/edit this field" K X
30 Q
31E2D ;Emer2 Delete
32 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
33 I $D(^DPT(DFN,.331)),$P(^(.331),U,1)]"" W !?4,*7,"Can't be deleted as long as 'EMERGENCY CONTACT-2' is specified" K X
34 Q
35D ;Desig Add
36 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
37 I $S('$D(^DPT(DFN,.34)):1,$P(^(.34),U,1)']"":1,1:0) W !?4,*7,"'DESIGNEE' name must be specified to enter/edit this field" K X
38 Q
39DD ;Desig Delete
40 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
41 I $D(^DPT(DFN,.34)),$P(^(.34),U,1)]"" W !?4,*7,"Can't be deleted as long as 'DESIGNEE' is specified" K X
42 Q
43SDD ;Spouse/Dependent Delete
44 Q:'DA
45 I $D(^DGPR(408.13,DA,0)),$P(^(0),U,1)]"" D EN^DDIOL(" Can't be deleted as long as Spouse/Dependent Income Person is specified.") K X
46 Q
47EM ;Emp Add
48 I $S('$D(^DPT(DA,.311)):1,"^3^9^"[$P(^(.311),U,15):1,1:0) G EMW
49 Q
50EMW W !?4,*7,"'EMPLOYMENT STATUS' must be specified to enter/edit this field" K X Q
51EM1 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
52 I $S('$D(^DPT(DFN,.311)):1,"^3^9^"[$P(^(.311),U,15):1,1:0) G EMW
53 I $P(^DPT(DFN,.311),U)']"" W !?4,*7,"'EMPLOYER NAME' must be specified to enter/edit this field" K X
54 Q
55EMD ;Emp Delete
56 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
57 I $D(^DPT(DFN,.311)),$P(^(.311),U,1)]"" W !?4,*7,"Can't be deleted as long as 'EMPLOYER NAME' is specified" K X
58 Q
59SE ;Sp Emp Add
60 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
61 D MAR I $D(X),$S('$D(^DPT(DFN,.25)):1,$P(^(.25),U,1)']"":1,1:0) W !?4,*7,"'SPOUSES EMPLOYER' name must be specified to enter/edit this field" K X
62 Q
63SED ;Sp Emp Delete
64 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
65 I $D(^DPT(DFN,.25)),$P(^(.25),U,1)]"" W !?4,*7,"Can't be deleted as long as 'SPOUSES EMPLOYER' is specified" K X
66 Q
67MAR ;Married or Separated
68 I '$G(DFN) N DFN S DFN=$G(DA) Q:'DFN
69 I $S('$D(^DIC(11,+$P(^DPT(DFN,0),U,5),0)):1,$P(^(0),U,1)="MARRIED":0,$P(^(0),U,1)="SEPARATED":0,1:1) W !?4,*7,"NOT POSSIBLE...Applicant is not Married." K X Q
70 Q
71AAC1 ;Agency/Country Screen
72 S DGAAC=$S($D(^DPT(DFN,.36)):$S($D(^DIC(8,+$P(^DPT(DFN,.36),U,1),0)):+$P(^(0),U,4),1:""),1:""),DGAAC(1)=$S('$D(^DPT(DFN,"VET")):"",^("VET")'="N":"",DGAAC=4:"A",DGAAC=5:"C",1:"")
73 Q
74AAC D AAC1 S DIC("S")="I $P(^(0),U,4)=DGAAC(1)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X Q
75 ;
76DOL I $S(X']"":1,X'["*":1,1:0) S:X["$" X=+$P(X,"$",2) G DOL2
77DOL1 I $L(X),"$*"[$E(X) S X=$E(X,2,999) G DOL1
78 Q:'+X S X=+X,X=X*12
79DOL2 S:X["." X=+$P(X,".",1)_"."_$E($P(X,".",2)_"00",1,2) W " ($",X,")" Q
80TOTCHK(DFN) ;Returns 1 if Any of 4 'Received' YES/NO amounts =YES
81 ;For A&A, HB, Pension, Disability
82 S:'$D(DFN) DFN=DA
83 Q ($P($G(^DPT(DFN,.362)),U,12,14)_$P($G(^DPT(DFN,.3)),U,11))["Y"
84TOTCKMSG ;ERROR MESSAGE FOR ABOVE
85 W !,?4,*7,"Must Receive A&A, HB, Pension, or Disability Benefits."
86 Q
87TOTCKDEL ;ERROR MESSAGE IF DELETE .36295
88 S DFN=DA I $$TOTCHK(DFN) W !,?4,*7,"Delete by indicating receipt of A&A, HB, Pension, & Disability as 'NO'." K X
89 Q
Note: See TracBrowser for help on using the repository browser.