source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDEMB.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1GMTSDEMB ; SLC/DLT,KER - Brief Demographic Component ; 12/11/2002
2 ;;2.7;Health Summary;**29,49,55,56,60**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 2056 $$GET1^DIQ (file #4)
6 ; DBIA 10061 ADD^VADPT
7 ; DBIA 10061 DEM^VADPT
8 ; DBIA 10061 ELIG^VADPT
9 ; DBIA 2990 TFL^VAFCTFU1
10 ; DBIA 10103 $$FMTE^XLFDT
11 ; DBIA 2171 $$LKUP^XUAF4
12 ;
13DEMOG ; Brief Demographics (VADPT)
14 N I,IX,VA,VAEL,VADM,VAPA,GMTSS,GMTSOUT,GMTSR D ELIG^VADPT,ADD^VADPT,DEM^VADPT
15 D CKP^GMTSUP Q:$D(GMTSQIT) W ?12,"Address: "_$S($L(VAPA(1)):VAPA(1),1:"Not available"),?53," Phone:",?61,VAPA(8),!
16 I VAPA(2)'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,VAPA(2),!
17 I VAPA(3)'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,VAPA(3),!
18 I VAPA(4)'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,VAPA(4),", ",$P(VAPA(5),"^",2)," ",VAPA(6),!
19 D CKP^GMTSUP Q:$D(GMTSQIT) W ?8,"Eligibility: ",?21,$P(VAEL(1),"^",2)
20 I VADM(4)'="" D CKP^GMTSUP Q:$D(GMTSIT) W ?56,"Age: ",$P(VADM(4),"^",1),!
21 I VAEL(9)'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?9,"Means Test: ",$P(VAEL(9),"^",2)
22 I VADM(5)'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?56,"Sex: ",$P(VADM(5),"^",2),!
23 D RACE^GMTSDEM2
24 D CD^GMTSDEMP(DFN) Q:$D(GMTSQIT) D TF(DFN) Q:$D(GMTSQIT) D SRC
25 K I,IX,VA,VAEL,VAPA
26 Q
27TF(X) ; Treating Facilities
28 Q:$D(GMTSQIT) N DFN,GMTSC,GMTSDS,GMTSI,GMTSIEN,GMTSIT,GMTSS
29 N GMTSTA,GMTSTF,GMTSTF2,GMTSTFC,GMTSTY,GMTSTFT
30 S GMTSTFC=0,DFN=+($G(X)),U="^" D TFL^VAFCTFU1(.GMTSTF,+($G(DFN)))
31 S (GMTSLP,GMTSC,GMTSI,GMTSS)=0
32 F S GMTSI=$O(GMTSTF(GMTSI)) Q:+GMTSI=0 D
33 . S GMTSTFT=$G(GMTSTF(GMTSI))
34 . S:+($G(GMTSTF(GMTSI)))=776!(+($G(GMTSTF(GMTSI)))=200) $P(GMTSTFT,"^",2)="DEPT. OF DEFENSE"
35 . S GMTSTF2((99999999-(+($P($P($G(GMTSTF(GMTSI)),"^",3),".",1)))),+($$LKUP^XUAF4($P($G(GMTSTF(GMTSI)),"^",2))))=GMTSTFT
36 S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSTF2(GMTSI)) Q:+GMTSI=0 D Q:$D(GMTSQIT)
37 . S GMTSIEN="" F S GMTSIEN=$O(GMTSTF2(GMTSI,GMTSIEN)) Q:GMTSIEN="" D Q:$D(GMTSQIT)
38 . . S GMTSTA=$P($G(GMTSTF2(GMTSI,GMTSIEN)),"^",1)
39 . . S GMTSIT=$P($G(GMTSTF2(GMTSI,GMTSIEN)),"^",2) Q:'$L(GMTSIT)
40 . . Q:GMTSIT="NO ICN"
41 . . S GMTSDS=$P($P($G(GMTSTF2(GMTSI,GMTSIEN)),"^",3),".",1)
42 . . S:+GMTSDS>0 GMTSLP=1 S:+GMTSDS'>0 GMTSDS="",GMTSLP=0 Q:+GMTSLP=0
43 . . S:+GMTSDS>0 GMTSDS=$TR($$FMTE^XLFDT(GMTSDS,"5DZ"),"@"," ")
44 . . S:GMTSDS="" GMTSDS="--/--/----" S:+GMTSLP>0 GMTSC=GMTSC+1
45 . . I GMTSC=1 D Q:$D(GMTSQIT)
46 . . . N STR
47 . . . D WRT^GMTSDEM("",,,,0) Q:$D(GMTSQIT)
48 . . . S STR=" Treating Facility Type Station Last Seen"
49 . . . D WRT^GMTSDEM(STR,,,,0) Q:$D(GMTSQIT)
50 . . . S STR=" ---------------------------- ----------- ------- ----------"
51 . . . D WRT^GMTSDEM(STR,,,,0) Q:$D(GMTSQIT)
52 . . Q:$D(GMTSQIT)
53 . . S GMTSTY=$$GET1^DIQ(4,(+GMTSIEN_","),13,"E")
54 . . S:+GMTSTA<0 (GMTSTA,GMTSDS)=""
55 . . S:GMTSIT="NO ICN" GMTSIT="Not available"
56 . . S STR=" "_$G(GMTSIT)
57 . . S STR=STR_$J("",(36-$L(STR)))_$G(GMTSTY)
58 . . S STR=STR_$J("",(49-$L(STR)))_$J($G(GMTSTA),6)
59 . . S STR=STR_$J("",(61-$L(STR)))_$G(GMTSDS)
60 . . D WRT^GMTSDEM(STR,,,,0)
61 . . S GMTSTFC=GMTSTFC+1
62 Q
63SRC ; Source of Info
64 Q:$D(GMTSQIT) N GMTSS,GMTSR,GMTSN,GMTST S GMTSR=0
65 ; National Health Summary Type
66 S GMTSN=$S(+($G(^GMT(142,+($G(GMTSTYP)),"VA")))>0:1,1:0)
67 ; Health Summary Type Name
68 S GMTST=$P($G(^GMT(142,+($G(GMTSTYP)),0)),"^",1)
69 ; Remote Data View HS Type
70 S:GMTSN>0&(GMTST["REMOTE") GMTSR=1
71 ; Demographics Array
72 S:$D(GMTSDEMX) GMTSR=1
73 S GMTSS=$$SITE^GMTSU2 I GMTSR>0,$L(GMTSS) D Q:$D(GMTSQIT)
74 . D WRT^GMTSDEM("",,,,0) N STR
75 . S STR=" Source of Info: "_GMTSS D WRT^GMTSDEM(STR,,,,0)
76 Q
Note: See TracBrowser for help on using the repository browser.