GMTSDEMB ; SLC/DLT,KER - Brief Demographic Component ; 12/11/2002
;;2.7;Health Summary;**29,49,55,56,60**;Oct 20, 1995
;
; External References
; DBIA 2056 $$GET1^DIQ (file #4)
; DBIA 10061 ADD^VADPT
; DBIA 10061 DEM^VADPT
; DBIA 10061 ELIG^VADPT
; DBIA 2990 TFL^VAFCTFU1
; DBIA 10103 $$FMTE^XLFDT
; DBIA 2171 $$LKUP^XUAF4
;
DEMOG ; Brief Demographics (VADPT)
N I,IX,VA,VAEL,VADM,VAPA,GMTSS,GMTSOUT,GMTSR D ELIG^VADPT,ADD^VADPT,DEM^VADPT
D CKP^GMTSUP Q:$D(GMTSQIT) W ?12,"Address: "_$S($L(VAPA(1)):VAPA(1),1:"Not available"),?53," Phone:",?61,VAPA(8),!
I VAPA(2)'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,VAPA(2),!
I VAPA(3)'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,VAPA(3),!
I VAPA(4)'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,VAPA(4),", ",$P(VAPA(5),"^",2)," ",VAPA(6),!
D CKP^GMTSUP Q:$D(GMTSQIT) W ?8,"Eligibility: ",?21,$P(VAEL(1),"^",2)
I VADM(4)'="" D CKP^GMTSUP Q:$D(GMTSIT) W ?56,"Age: ",$P(VADM(4),"^",1),!
I VAEL(9)'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?9,"Means Test: ",$P(VAEL(9),"^",2)
I VADM(5)'="" D CKP^GMTSUP Q:$D(GMTSQIT) W ?56,"Sex: ",$P(VADM(5),"^",2),!
D RACE^GMTSDEM2
D CD^GMTSDEMP(DFN) Q:$D(GMTSQIT) D TF(DFN) Q:$D(GMTSQIT) D SRC
K I,IX,VA,VAEL,VAPA
Q
TF(X) ; Treating Facilities
Q:$D(GMTSQIT) N DFN,GMTSC,GMTSDS,GMTSI,GMTSIEN,GMTSIT,GMTSS
N GMTSTA,GMTSTF,GMTSTF2,GMTSTFC,GMTSTY,GMTSTFT
S GMTSTFC=0,DFN=+($G(X)),U="^" D TFL^VAFCTFU1(.GMTSTF,+($G(DFN)))
S (GMTSLP,GMTSC,GMTSI,GMTSS)=0
F S GMTSI=$O(GMTSTF(GMTSI)) Q:+GMTSI=0 D
. S GMTSTFT=$G(GMTSTF(GMTSI))
. S:+($G(GMTSTF(GMTSI)))=776!(+($G(GMTSTF(GMTSI)))=200) $P(GMTSTFT,"^",2)="DEPT. OF DEFENSE"
. S GMTSTF2((99999999-(+($P($P($G(GMTSTF(GMTSI)),"^",3),".",1)))),+($$LKUP^XUAF4($P($G(GMTSTF(GMTSI)),"^",2))))=GMTSTFT
S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSTF2(GMTSI)) Q:+GMTSI=0 D Q:$D(GMTSQIT)
. S GMTSIEN="" F S GMTSIEN=$O(GMTSTF2(GMTSI,GMTSIEN)) Q:GMTSIEN="" D Q:$D(GMTSQIT)
. . S GMTSTA=$P($G(GMTSTF2(GMTSI,GMTSIEN)),"^",1)
. . S GMTSIT=$P($G(GMTSTF2(GMTSI,GMTSIEN)),"^",2) Q:'$L(GMTSIT)
. . Q:GMTSIT="NO ICN"
. . S GMTSDS=$P($P($G(GMTSTF2(GMTSI,GMTSIEN)),"^",3),".",1)
. . S:+GMTSDS>0 GMTSLP=1 S:+GMTSDS'>0 GMTSDS="",GMTSLP=0 Q:+GMTSLP=0
. . S:+GMTSDS>0 GMTSDS=$TR($$FMTE^XLFDT(GMTSDS,"5DZ"),"@"," ")
. . S:GMTSDS="" GMTSDS="--/--/----" S:+GMTSLP>0 GMTSC=GMTSC+1
. . I GMTSC=1 D Q:$D(GMTSQIT)
. . . N STR
. . . D WRT^GMTSDEM("",,,,0) Q:$D(GMTSQIT)
. . . S STR=" Treating Facility Type Station Last Seen"
. . . D WRT^GMTSDEM(STR,,,,0) Q:$D(GMTSQIT)
. . . S STR=" ---------------------------- ----------- ------- ----------"
. . . D WRT^GMTSDEM(STR,,,,0) Q:$D(GMTSQIT)
. . Q:$D(GMTSQIT)
. . S GMTSTY=$$GET1^DIQ(4,(+GMTSIEN_","),13,"E")
. . S:+GMTSTA<0 (GMTSTA,GMTSDS)=""
. . S:GMTSIT="NO ICN" GMTSIT="Not available"
. . S STR=" "_$G(GMTSIT)
. . S STR=STR_$J("",(36-$L(STR)))_$G(GMTSTY)
. . S STR=STR_$J("",(49-$L(STR)))_$J($G(GMTSTA),6)
. . S STR=STR_$J("",(61-$L(STR)))_$G(GMTSDS)
. . D WRT^GMTSDEM(STR,,,,0)
. . S GMTSTFC=GMTSTFC+1
Q
SRC ; Source of Info
Q:$D(GMTSQIT) N GMTSS,GMTSR,GMTSN,GMTST S GMTSR=0
; National Health Summary Type
S GMTSN=$S(+($G(^GMT(142,+($G(GMTSTYP)),"VA")))>0:1,1:0)
; Health Summary Type Name
S GMTST=$P($G(^GMT(142,+($G(GMTSTYP)),0)),"^",1)
; Remote Data View HS Type
S:GMTSN>0&(GMTST["REMOTE") GMTSR=1
; Demographics Array
S:$D(GMTSDEMX) GMTSR=1
S GMTSS=$$SITE^GMTSU2 I GMTSR>0,$L(GMTSS) D Q:$D(GMTSQIT)
. D WRT^GMTSDEM("",,,,0) N STR
. S STR=" Source of Info: "_GMTSS D WRT^GMTSDEM(STR,,,,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSDEMB 3665 printed Sep 23, 2025@19:33:19 Page 2
GMTSDEMB ; SLC/DLT,KER - Brief Demographic Component ; 12/11/2002
+1 ;;2.7;Health Summary;**29,49,55,56,60**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 2056 $$GET1^DIQ (file #4)
+5 ; DBIA 10061 ADD^VADPT
+6 ; DBIA 10061 DEM^VADPT
+7 ; DBIA 10061 ELIG^VADPT
+8 ; DBIA 2990 TFL^VAFCTFU1
+9 ; DBIA 10103 $$FMTE^XLFDT
+10 ; DBIA 2171 $$LKUP^XUAF4
+11 ;
DEMOG ; Brief Demographics (VADPT)
+1 NEW I,IX,VA,VAEL,VADM,VAPA,GMTSS,GMTSOUT,GMTSR
DO ELIG^VADPT
DO ADD^VADPT
DO DEM^VADPT
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?12,"Address: "_$SELECT($LENGTH(VAPA(1)):VAPA(1),1:"Not available"),?53," Phone:",?61,VAPA(8),!
+3 IF VAPA(2)'=""
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?21,VAPA(2),!
+4 IF VAPA(3)'=""
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?21,VAPA(3),!
+5 IF VAPA(4)'=""
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?21,VAPA(4),", ",$PIECE(VAPA(5),"^",2)," ",VAPA(6),!
+6 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?8,"Eligibility: ",?21,$PIECE(VAEL(1),"^",2)
+7 IF VADM(4)'=""
DO CKP^GMTSUP
if $DATA(GMTSIT)
QUIT
WRITE ?56,"Age: ",$PIECE(VADM(4),"^",1),!
+8 IF VAEL(9)'=""
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?9,"Means Test: ",$PIECE(VAEL(9),"^",2)
+9 IF VADM(5)'=""
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?56,"Sex: ",$PIECE(VADM(5),"^",2),!
+10 DO RACE^GMTSDEM2
+11 DO CD^GMTSDEMP(DFN)
if $DATA(GMTSQIT)
QUIT
DO TF(DFN)
if $DATA(GMTSQIT)
QUIT
DO SRC
+12 KILL I,IX,VA,VAEL,VAPA
+13 QUIT
TF(X) ; Treating Facilities
+1 if $DATA(GMTSQIT)
QUIT
NEW DFN,GMTSC,GMTSDS,GMTSI,GMTSIEN,GMTSIT,GMTSS
+2 NEW GMTSTA,GMTSTF,GMTSTF2,GMTSTFC,GMTSTY,GMTSTFT
+3 SET GMTSTFC=0
SET DFN=+($GET(X))
SET U="^"
DO TFL^VAFCTFU1(.GMTSTF,+($GET(DFN)))
+4 SET (GMTSLP,GMTSC,GMTSI,GMTSS)=0
+5 FOR
SET GMTSI=$ORDER(GMTSTF(GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+6 SET GMTSTFT=$GET(GMTSTF(GMTSI))
+7 if +($GET(GMTSTF(GMTSI)))=776!(+($GET(GMTSTF(GMTSI)))=200)
SET $PIECE(GMTSTFT,"^",2)="DEPT. OF DEFENSE"
+8 SET GMTSTF2((99999999-(+($PIECE($PIECE($GET(GMTSTF(GMTSI)),"^",3),".",1)))),+($$LKUP^XUAF4($PIECE($GET(GMTSTF(GMTSI)),"^",2))))=GMTSTFT
End DoDot:1
+9 SET (GMTSC,GMTSI)=0
FOR
SET GMTSI=$ORDER(GMTSTF2(GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+10 SET GMTSIEN=""
FOR
SET GMTSIEN=$ORDER(GMTSTF2(GMTSI,GMTSIEN))
if GMTSIEN=""
QUIT
Begin DoDot:2
+11 SET GMTSTA=$PIECE($GET(GMTSTF2(GMTSI,GMTSIEN)),"^",1)
+12 SET GMTSIT=$PIECE($GET(GMTSTF2(GMTSI,GMTSIEN)),"^",2)
if '$LENGTH(GMTSIT)
QUIT
+13 if GMTSIT="NO ICN"
QUIT
+14 SET GMTSDS=$PIECE($PIECE($GET(GMTSTF2(GMTSI,GMTSIEN)),"^",3),".",1)
+15 if +GMTSDS>0
SET GMTSLP=1
if +GMTSDS'>0
SET GMTSDS=""
SET GMTSLP=0
if +GMTSLP=0
QUIT
+16 if +GMTSDS>0
SET GMTSDS=$TRANSLATE($$FMTE^XLFDT(GMTSDS,"5DZ"),"@"," ")
+17 if GMTSDS=""
SET GMTSDS="--/--/----"
if +GMTSLP>0
SET GMTSC=GMTSC+1
+18 IF GMTSC=1
Begin DoDot:3
+19 NEW STR
+20 DO WRT^GMTSDEM("",,,,0)
if $DATA(GMTSQIT)
QUIT
+21 SET STR=" Treating Facility Type Station Last Seen"
+22 DO WRT^GMTSDEM(STR,,,,0)
if $DATA(GMTSQIT)
QUIT
+23 SET STR=" ---------------------------- ----------- ------- ----------"
+24 DO WRT^GMTSDEM(STR,,,,0)
if $DATA(GMTSQIT)
QUIT
End DoDot:3
if $DATA(GMTSQIT)
QUIT
+25 if $DATA(GMTSQIT)
QUIT
+26 SET GMTSTY=$$GET1^DIQ(4,(+GMTSIEN_","),13,"E")
+27 if +GMTSTA<0
SET (GMTSTA,GMTSDS)=""
+28 if GMTSIT="NO ICN"
SET GMTSIT="Not available"
+29 SET STR=" "_$GET(GMTSIT)
+30 SET STR=STR_$JUSTIFY("",(36-$LENGTH(STR)))_$GET(GMTSTY)
+31 SET STR=STR_$JUSTIFY("",(49-$LENGTH(STR)))_$JUSTIFY($GET(GMTSTA),6)
+32 SET STR=STR_$JUSTIFY("",(61-$LENGTH(STR)))_$GET(GMTSDS)
+33 DO WRT^GMTSDEM(STR,,,,0)
+34 SET GMTSTFC=GMTSTFC+1
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+35 QUIT
SRC ; Source of Info
+1 if $DATA(GMTSQIT)
QUIT
NEW GMTSS,GMTSR,GMTSN,GMTST
SET GMTSR=0
+2 ; National Health Summary Type
+3 SET GMTSN=$SELECT(+($GET(^GMT(142,+($GET(GMTSTYP)),"VA")))>0:1,1:0)
+4 ; Health Summary Type Name
+5 SET GMTST=$PIECE($GET(^GMT(142,+($GET(GMTSTYP)),0)),"^",1)
+6 ; Remote Data View HS Type
+7 if GMTSN>0&(GMTST["REMOTE")
SET GMTSR=1
+8 ; Demographics Array
+9 if $DATA(GMTSDEMX)
SET GMTSR=1
+10 SET GMTSS=$$SITE^GMTSU2
IF GMTSR>0
IF $LENGTH(GMTSS)
Begin DoDot:1
+11 DO WRT^GMTSDEM("",,,,0)
NEW STR
+12 SET STR=" Source of Info: "_GMTSS
DO WRT^GMTSDEM(STR,,,,0)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+13 QUIT
