- 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 Apr 23, 2025@18:11:43 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
