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

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1DGDEP ;ALB/CAW Dependent Driver ;10/31/94
2 ;;5.3;Registration;**45**;Aug 13, 1993
3 ;
4EN ;
5 S VALMBCK=""
6 D WAIT^DICD,EN^VALM("DGMT DEPENDENTS")
7 S VALMBCK="R"
8ENQ K DEP,DGCNT,DGDEP,DGIR0,DGINI,DGLN,DGPRI,DGREL,^TMP("DGDEP",$J)
9 Q
10 ;
11PAT ; Patient Lookup
12 N DIC,Y
13 S DIC="^DPT(",DIC(0)="AEMQZ" D ^DIC I Y'>0 G PATQ
14 I ($G(DTOUT)!$G(DUOUT)) G PATQ
15 S DFN=+Y
16PATQ Q
17 ;
18HDR ; Header
19 N VA,VAERR
20 D PID^VADPT
21 I $G(DGSCR8) D G HDRQ
22 .S X="",VALMHDR(1)=" FAMILY DEMOGRAPHIC DATA, SCREEN <8>"
23 .S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),80-$L(X),$L(X))
24 .S VALMHDR(2)=$E($P("Patient: "_$G(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("PID")_")"
25 .S X=$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
26 .S VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),80-$L(X),$L(X))
27 S X="",VALMHDR(1)=" MARITAL STATUS/DEPENDENTS, SCREEN <1>"
28 S VALMHDR(2)=$E($P("Patient: "_$G(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("PID")_")"
29 S X=$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
30 S VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),80-$L(X),$L(X))
31HDRQ Q
32 ;
33INIT ; Find all dependents
34 K DGDEP("DGDEP",$J),^TMP("DGDEP",$J)
35 N CNT,DGDATE,DGDDEP0,DGINCP,DGINI,DGIRI,DGWHERE
36 D NEW^DGRPEIS1 ; Sets up veteran in person file
37 ; Get all active dependents
38 D ALL^DGMTU21(DFN,"VSD",$S($G(DGMTDT):DGMTDT,1:DT),"IPR",$G(DGMTI))
39 ;
40 ; Get all dependents active and inactive
41 S (CNT,DGDEP)=0,DGLN=1
42 F S DGDEP=$O(^DGPR(408.12,"B",DFN,DGDEP)) Q:'DGDEP D
43 .N DGDEP0 S CNT=CNT+1
44 .S DGDEP0=^DGPR(408.12,DGDEP,0)
45 .D GETIENS^DGMTU2(DFN,+DGDEP,$S($G(DGMTDT):DGMTDT,1:DT)) ;Get Annual Income IEN and Income Person IEN
46 .S DGWHERE=$P(DGDEP0,U,3)
47 .S DGINCP=$G(@("^"_$P(DGWHERE,";",2)_+DGWHERE_",0)"))
48 .S DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT)=DGINCP
49 .S $P(DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT),U,20)=DGDEP
50 .S $P(DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT),U,21)=$S($G(DGINI):DGINI,1:$G(DGINC))
51 .S $P(DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT),U,22)=$S($G(DGIRI):DGIRI,1:$G(DGINR))
52 .N DGEDATE S DGEDATE=0
53 .F S DGEDATE=$O(^DGPR(408.12,DGDEP,"E",DGEDATE)) Q:'DGEDATE D
54 ..S DGDATE=^DGPR(408.12,DGDEP,"E",DGEDATE,0)
55 ..S DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT,-$P(DGDATE,U))=DGDATE
56 D RETDEP^DGDEP0
57 S VALMCNT=DGLN-1
58 Q
59 ;
60SET(X) ; Set in array
61 ;
62 S ^TMP("DGDEP",$J,DGLN,0)=X,^TMP("DGDEP",$J,"IDX",CNT,CNT)=""
63 S DGLN=DGLN+1
64 Q
Note: See TracBrowser for help on using the repository browser.