GMTSDEM ; SLC/DLT,KER - Demographics ; 12/11/2002
;;2.7;Health Summary;**28,49,55,56,60,73**;Oct 20, 1995
;
; External References
; DBIA 10061 OAD^VADPT
; DBIA 10061 OPD^VADPT
; DBIA 10061 SVC^VADPT
; DBIA 10061 ADD^VADPT
; DBIA 10061 DEM^VADPT
; DBIA 10061 ELIG^VADPT
; DBIA 2967 ^DIC(31,
; DBIA 10035 ^DPT( (file #2)
;
DEMOG ; Demographic (VADPT)
N I,VA,VADM,VAERR,VAOA,VASV,VAPA,VAPD,VAEL,SCD,SCDS,SCDP,FROM,GMI,TO,IX,X,Z
D ADR,PER,SVC,BOS,COMB,ELIG,SC,SCDD,MT
D NOK^GMTSDEM2,CD^GMTSDEMP(+($G(DFN)))
D INS^GMTSDEM2,TF^GMTSDEMB(+($G(DFN)))
D SRC^GMTSDEMB,END
Q
DEMO(DFN) ;
K ^TMP("GMTSDEMO",$J,+($G(DFN)))
N GMTSDEMX,I,VA,VADM,VAERR,VAOA,VASV,VAPA,VAPD,VAEL,SCD,SCDS,SCDP,FROM,GMI,TO,IX,X,Z
S GMTSDEMX="" D DEMOG D:$D(GMTSTEST) ST
Q
ADR ; Patient Address
Q:$D(GMTSQIT) D:$D(GMTSDEMX) NAM Q:$D(GMTSQIT) N %,%H,VA,VAPA,VAERR D ADD^VADPT
D WRT("Address",$S($L(VAPA(1)):VAPA(1),1:"Not available"),"Phone",VAPA(8),1) Q:$D(GMTSQIT)
I VAPA(2)'="" D WRT(($J("",21)_VAPA(2)),,,,0) Q:$D(GMTSQIT)
I VAPA(3)'="" D WRT(($J("",21)_VAPA(3)),,,,0) Q:$D(GMTSQIT)
I VAPA(4)'="" D Q:$D(GMTSQIT)
. N STR S STR=VAPA(4)_", " S:VAPA(5)'="" STR=STR_$P($G(VAPA(5)),"^",2)_" "
. S:VAPA(6)'="" STR=STR_VAPA(6) D WRT("",STR,"County",$P(VAPA(7),"^",2),1)
D WRT(" ",,,,0)
Q
NAM ; Name/SSN/DOB/Sex
N VAPTYP,VAHOW,VAROUT,VADM D DEM^VADPT
D WRT("Name",$G(VADM(1)),"SSN",$E($P($G(VADM(2)),"^",2),1,11),1)
D WRT("Date of Birth",$$EDT^GMTSU($P($G(VADM(3)),"^",1)),,,1)
Q
PER ; Personal
Q:$D(GMTSQIT) N %,%H,VA,VADM,VAERR,VAPD D DEM^VADPT,OPD^VADPT
I VADM(10)'=""!(VADM(4)'="") D Q:$D(GMTSQIT)
. D WRT("Marital Status",$P($G(VADM(10)),"^",2),"Age",$P($G(VADM(4)),"^",1),1)
I VADM(9)'=""!(VADM(5)'="") D Q:$D(GMTSQIT)
. D WRT("Religion",$P($G(VADM(9)),"^",2),"Sex",$P($G(VADM(5)),"^",2),1)
D RACE^GMTSDEM2 I VAPD(6)'="" D Q:$D(GMTSQIT)
. D WRT("Occupation",$P($G(VAPD(6)),"^",1),,,1)
Q
SVC ; Service
Q:$D(GMTSQIT) N %,%H,VAEL,VAERR D ELIG^VADPT
I $P(VAEL(2),"^",1) D Q:$D(GMTSQIT)
. D WRT("Period of Service",$P($G(VAEL(2)),"^",2),,,1)
Q
BOS ; Branch of Service
Q:$D(GMTSQIT) N %,%H,VAEL,VAERR,VASV,GMTSI,FROM,TO
D SVC^VADPT F GMTSI=6,7,8 D
. Q:'$D(VASV(GMTSI)) Q:+(VASV(GMTSI))=0
. S FROM=$$EDT^GMTSU($P(VASV(GMTSI,4),U,1))
. S TO=$$EDT^GMTSU($P(VASV(GMTSI,5),U,1))
. S:$L(FROM)&('$L(TO)) TO="UNKNOWN"
. D:GMTSI=6 WRT("Branch of Service",($P(VASV(GMTSI,1),U,2)_" "_FROM_" TO "_TO),,,1)
. D:GMTSI'=6 WRT("",($P(VASV(GMTSI,1),U,2)_" "_FROM_" TO "_TO),,,1)
Q
COMB ; Service Connected Disabilities
Q:$D(GMTSQIT) N %,%H,VAEL,VAERR,VASV D ELIG^VADPT,SVC^VADPT
I $P(VAEL(2),U) D Q:$D(GMTSQIT)
. D WRT("Combat",$S(VASV(5):"YES",1:"NO"),"POW",$S(VASV(4):"YES",1:"NO"),1)
Q
ELIG ; Eligibility
Q:$D(GMTSQIT) N Z,I,%,%H,VAEL,VAERR D ELIG^VADPT
I $P(VAEL(1),"^",1) D Q:$D(GMTSQIT)
. D WRT("Eligibility",$P(VAEL(1),"^",2),$S(VAEL(8)'="":"Status",1:""),$P(VAEL(8),"^",2),1)
I $O(VAEL(1,0)) D Q:$D(GMTSQIT)
. S I=0 F Z=0:0 D Q:$D(GMTSQIT) Q:I=""
. . Q:$D(GMTSQIT) S I=$O(VAEL(1,I)) Q:I=""
. . D WRT("",$P(VAEL(1,I),"^",2),,,1)
Q
SC ; Service Connected Percent
Q:$D(GMTSQIT) N %,%H,VAEL,VAERR D ELIG^VADPT
D:VAEL(3) WRT("S/C %",$P(VAEL(3),"^",2),,,1)
Q
SCDD ; Service Connected Disabilities/Diagnosis
Q:$D(GMTSQIT) N SCD,SCDP,SCDS,IX,GMTSC S (IX,GMTSC)=0
F S IX=$O(^DPT(DFN,.372,IX)) Q:$D(GMTSQIT) Q:+IX=0 D SCDP Q:$D(GMTSQIT)
Q
SCDP ; Service Connected Diagnosis
Q:$D(GMTSQIT) N SCD,SCDS,SCDP S SCD=^DPT(DFN,.372,IX,0)
S SCDS=$S($P(SCD,"^",1):$P(^DIC(31,$P(SCD,"^",1),0),"^",1),1:"")
S SCDP=$P(SCD,"^",2)_"% "_$S($P(SCD,"^",3):"SC",1:"")
S GMTSC=+($G(GMTSC))+1
I +($G(GMTSC))'>1 D Q:$D(GMTSQIT)
. S STR=" S/C Disabilities: "_SCDS,STR=STR_$J("",(61-$L(STR)))_SCDP
. D WRT(STR,,,,0)
I +($G(GMTSC))>1 D
. S STR=$J("",21)_SCDS,STR=STR_$J("",(61-$L(STR)))_SCDP
. D WRT(STR,,,,0)
Q
MT ; Means Test
Q:$D(GMTSQIT) N %,%H,VAEL,VAERR D ELIG^VADPT
D:VAEL(9)'="" WRT("Means Test",$P(VAEL(9),"^",2),,,1)
Q
NOK ; Next of Kin
Q:$D(GMTSQIT) N %,%H,VAOA S VAOA("A")=1 D OAD^VADPT
Q:VAOA(9)="" I VAOA(9)'="" D Q:$D(GMTSQIT)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W ?16,"NOK: ",VAOA(9)
. W:VAOA(10)'="" ?51,"Relation: ",VAOA(10) W !
I VAOA(1)'="" D Q:$D(GMTSQIT)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W:VAOA(1)]"" ?21,VAOA(1)
. W:VAOA(8)'="" ?54,"Phone: ",VAOA(8) W !
I VAOA(2)'="" D Q:$D(GMTSQIT)
. D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,VAOA(2),!
I VAOA(3)'="" D Q:$D(GMTSQIT)
. D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,VAOA(3),!
I VAOA(4)'="" D Q:$D(GMTSQIT)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W ?21,VAOA(4) W:VAOA(5) ", ",$P(VAOA(5),U,2)
. W:VAOA(6) " ",VAOA(6) W !
Q
IEN ; Ineligible for Care Data
Q:$D(GMTSQIT) N STR,REM,WRD,%,%H,VAEL,VAERR,GMTSDT D ELIG^VADPT
I +($P(VAEL(5,1),U,1))>0 D
. S GMTSDT=$$EDT^GMTSU($P(VAEL(5,1),U,1))
. Q:$D(GMTSQIT) D WRT("Ineligible date",GMTSDT,,,1)
. Q:$D(GMTSQIT) S STR=$P(VAEL(5,2),U,2)_" "_VAEL(5,3)_", "_$P(VAEL(5,4),U,2)
. D WRT("Inelig. TWX source",STR,,,1)
. Q:$D(GMTSQIT) S STR=$G(VAEL(5,5))
. F WRD=1:1 Q:$L(STR)'>58 D
. . S REM=$P(STR," ",($L(STR," ")-WRD),$L(STR," "))
. . S STR=$P(STR," ",1,($L(STR," ")-(WRD+1)))
. D:$L(STR) WRT(($J("",21)_STR),,,,0)
. D:$L(REM) WRT(($J("",21)_REM),,,,0)
. D:$L(VAEL(5,6)) WRT("Reason",$E(VAEL(5,6),1,58),,,1)
Q
;
WRT(CH1,CD1,CH2,CD2,FMT) ; Write/Save Demographic Line
;
; Input
; CH1 - Column 1 Header or Preformated Line
; CD1 - Column 1 Data
; CH2 - Column 2 Header
; CD2 - Column 2 Data
; FMT - Format in Columns 1=Yes 0=No
;
; If the variable GMTSDEMX exist, then the data will
; be saved in a global array instead of written to the
; screen. Global array:
;
; ^TMP("GMTSDEMO",$J,DFN,#)=<demographic text>
Q:$D(GMTSQIT) N STR,BL,COL1,COL2,LN,LNLGTH
S LN=+($O(^TMP("GMTSDEMO",$J,+($G(DFN))," "),-1))+1,CH1=$G(CH1),CD1=$G(CD1),CH2=$G(CH2),CD2=$G(CD2),FMT=$G(FMT)
S:+FMT'>0 STR=CH1
I +FMT>0 D
. S LNLGTH=59
. S:CH2="" LNLGTH=78
. S BL=$J("",(19-$L(CH1))),CH1=BL_CH1_$S($L(CH1)>0:": ",1:" ")
. S BL=$J("",(((LNLGTH-$L(CH1))-$L(CH2))-2))
. S CD1=$E(CD1,1,$L(BL)),COL1=CH1_CD1
. S BL=$J("",((59-$L(COL1))-$L(CH2)))
. S CH2=BL_CH2_$S($L(CH2)>0:": ",1:" "),COL2=CH2_$E(CD2,1,17)
. S STR=COL1_COL2
I '$D(GMTSDEMX) D CKP^GMTSUP Q:$D(GMTSQIT) W $G(STR),!
S:$D(GMTSDEMX) ^TMP("GMTSDEMO",$J,+($G(DFN)),LN)=STR
Q
;
ST ; Show ^TMP Global Array
W !! N NN,NC S NN="^TMP(""GMTSDEMO"","_$J_","_+($G(DFN))_")",NC="^TMP(""GMTSDEMO"","_$J_","_+($G(DFN))_"," F S NN=$Q(@NN) Q:NN=""!(NN'[NC) W !,@NN
Q
END ; Clean-up and quit
K I,VA,VADM,VAERR,VAOA,VASV,VAPA,VAPD,VAEL,SCD,SCDS,SCDP,FROM
K GMI,TO,IX,X,Z Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSDEM 6924 printed Dec 13, 2024@01:57:14 Page 2
GMTSDEM ; SLC/DLT,KER - Demographics ; 12/11/2002
+1 ;;2.7;Health Summary;**28,49,55,56,60,73**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10061 OAD^VADPT
+5 ; DBIA 10061 OPD^VADPT
+6 ; DBIA 10061 SVC^VADPT
+7 ; DBIA 10061 ADD^VADPT
+8 ; DBIA 10061 DEM^VADPT
+9 ; DBIA 10061 ELIG^VADPT
+10 ; DBIA 2967 ^DIC(31,
+11 ; DBIA 10035 ^DPT( (file #2)
+12 ;
DEMOG ; Demographic (VADPT)
+1 NEW I,VA,VADM,VAERR,VAOA,VASV,VAPA,VAPD,VAEL,SCD,SCDS,SCDP,FROM,GMI,TO,IX,X,Z
+2 DO ADR
DO PER
DO SVC
DO BOS
DO COMB
DO ELIG
DO SC
DO SCDD
DO MT
+3 DO NOK^GMTSDEM2
DO CD^GMTSDEMP(+($GET(DFN)))
+4 DO INS^GMTSDEM2
DO TF^GMTSDEMB(+($GET(DFN)))
+5 DO SRC^GMTSDEMB
DO END
+6 QUIT
DEMO(DFN) ;
+1 KILL ^TMP("GMTSDEMO",$JOB,+($GET(DFN)))
+2 NEW GMTSDEMX,I,VA,VADM,VAERR,VAOA,VASV,VAPA,VAPD,VAEL,SCD,SCDS,SCDP,FROM,GMI,TO,IX,X,Z
+3 SET GMTSDEMX=""
DO DEMOG
if $DATA(GMTSTEST)
DO ST
+4 QUIT
ADR ; Patient Address
+1 if $DATA(GMTSQIT)
QUIT
if $DATA(GMTSDEMX)
DO NAM
if $DATA(GMTSQIT)
QUIT
NEW %,%H,VA,VAPA,VAERR
DO ADD^VADPT
+2 DO WRT("Address",$SELECT($LENGTH(VAPA(1)):VAPA(1),1:"Not available"),"Phone",VAPA(8),1)
if $DATA(GMTSQIT)
QUIT
+3 IF VAPA(2)'=""
DO WRT(($JUSTIFY("",21)_VAPA(2)),,,,0)
if $DATA(GMTSQIT)
QUIT
+4 IF VAPA(3)'=""
DO WRT(($JUSTIFY("",21)_VAPA(3)),,,,0)
if $DATA(GMTSQIT)
QUIT
+5 IF VAPA(4)'=""
Begin DoDot:1
+6 NEW STR
SET STR=VAPA(4)_", "
if VAPA(5)'=""
SET STR=STR_$PIECE($GET(VAPA(5)),"^",2)_" "
+7 if VAPA(6)'=""
SET STR=STR_VAPA(6)
DO WRT("",STR,"County",$PIECE(VAPA(7),"^",2),1)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+8 DO WRT(" ",,,,0)
+9 QUIT
NAM ; Name/SSN/DOB/Sex
+1 NEW VAPTYP,VAHOW,VAROUT,VADM
DO DEM^VADPT
+2 DO WRT("Name",$GET(VADM(1)),"SSN",$EXTRACT($PIECE($GET(VADM(2)),"^",2),1,11),1)
+3 DO WRT("Date of Birth",$$EDT^GMTSU($PIECE($GET(VADM(3)),"^",1)),,,1)
+4 QUIT
PER ; Personal
+1 if $DATA(GMTSQIT)
QUIT
NEW %,%H,VA,VADM,VAERR,VAPD
DO DEM^VADPT
DO OPD^VADPT
+2 IF VADM(10)'=""!(VADM(4)'="")
Begin DoDot:1
+3 DO WRT("Marital Status",$PIECE($GET(VADM(10)),"^",2),"Age",$PIECE($GET(VADM(4)),"^",1),1)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+4 IF VADM(9)'=""!(VADM(5)'="")
Begin DoDot:1
+5 DO WRT("Religion",$PIECE($GET(VADM(9)),"^",2),"Sex",$PIECE($GET(VADM(5)),"^",2),1)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+6 DO RACE^GMTSDEM2
IF VAPD(6)'=""
Begin DoDot:1
+7 DO WRT("Occupation",$PIECE($GET(VAPD(6)),"^",1),,,1)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+8 QUIT
SVC ; Service
+1 if $DATA(GMTSQIT)
QUIT
NEW %,%H,VAEL,VAERR
DO ELIG^VADPT
+2 IF $PIECE(VAEL(2),"^",1)
Begin DoDot:1
+3 DO WRT("Period of Service",$PIECE($GET(VAEL(2)),"^",2),,,1)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+4 QUIT
BOS ; Branch of Service
+1 if $DATA(GMTSQIT)
QUIT
NEW %,%H,VAEL,VAERR,VASV,GMTSI,FROM,TO
+2 DO SVC^VADPT
FOR GMTSI=6,7,8
Begin DoDot:1
+3 if '$DATA(VASV(GMTSI))
QUIT
if +(VASV(GMTSI))=0
QUIT
+4 SET FROM=$$EDT^GMTSU($PIECE(VASV(GMTSI,4),U,1))
+5 SET TO=$$EDT^GMTSU($PIECE(VASV(GMTSI,5),U,1))
+6 if $LENGTH(FROM)&('$LENGTH(TO))
SET TO="UNKNOWN"
+7 if GMTSI=6
DO WRT("Branch of Service",($PIECE(VASV(GMTSI,1),U,2)_" "_FROM_" TO "_TO),,,1)
+8 if GMTSI'=6
DO WRT("",($PIECE(VASV(GMTSI,1),U,2)_" "_FROM_" TO "_TO),,,1)
End DoDot:1
+9 QUIT
COMB ; Service Connected Disabilities
+1 if $DATA(GMTSQIT)
QUIT
NEW %,%H,VAEL,VAERR,VASV
DO ELIG^VADPT
DO SVC^VADPT
+2 IF $PIECE(VAEL(2),U)
Begin DoDot:1
+3 DO WRT("Combat",$SELECT(VASV(5):"YES",1:"NO"),"POW",$SELECT(VASV(4):"YES",1:"NO"),1)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+4 QUIT
ELIG ; Eligibility
+1 if $DATA(GMTSQIT)
QUIT
NEW Z,I,%,%H,VAEL,VAERR
DO ELIG^VADPT
+2 IF $PIECE(VAEL(1),"^",1)
Begin DoDot:1
+3 DO WRT("Eligibility",$PIECE(VAEL(1),"^",2),$SELECT(VAEL(8)'="":"Status",1:""),$PIECE(VAEL(8),"^",2),1)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+4 IF $ORDER(VAEL(1,0))
Begin DoDot:1
+5 SET I=0
FOR Z=0:0
Begin DoDot:2
+6 if $DATA(GMTSQIT)
QUIT
SET I=$ORDER(VAEL(1,I))
if I=""
QUIT
+7 DO WRT("",$PIECE(VAEL(1,I),"^",2),,,1)
End DoDot:2
if $DATA(GMTSQIT)
QUIT
if I=""
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+8 QUIT
SC ; Service Connected Percent
+1 if $DATA(GMTSQIT)
QUIT
NEW %,%H,VAEL,VAERR
DO ELIG^VADPT
+2 if VAEL(3)
DO WRT("S/C %",$PIECE(VAEL(3),"^",2),,,1)
+3 QUIT
SCDD ; Service Connected Disabilities/Diagnosis
+1 if $DATA(GMTSQIT)
QUIT
NEW SCD,SCDP,SCDS,IX,GMTSC
SET (IX,GMTSC)=0
+2 FOR
SET IX=$ORDER(^DPT(DFN,.372,IX))
if $DATA(GMTSQIT)
QUIT
if +IX=0
QUIT
DO SCDP
if $DATA(GMTSQIT)
QUIT
+3 QUIT
SCDP ; Service Connected Diagnosis
+1 if $DATA(GMTSQIT)
QUIT
NEW SCD,SCDS,SCDP
SET SCD=^DPT(DFN,.372,IX,0)
+2 SET SCDS=$SELECT($PIECE(SCD,"^",1):$PIECE(^DIC(31,$PIECE(SCD,"^",1),0),"^",1),1:"")
+3 SET SCDP=$PIECE(SCD,"^",2)_"% "_$SELECT($PIECE(SCD,"^",3):"SC",1:"")
+4 SET GMTSC=+($GET(GMTSC))+1
+5 IF +($GET(GMTSC))'>1
Begin DoDot:1
+6 SET STR=" S/C Disabilities: "_SCDS
SET STR=STR_$JUSTIFY("",(61-$LENGTH(STR)))_SCDP
+7 DO WRT(STR,,,,0)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+8 IF +($GET(GMTSC))>1
Begin DoDot:1
+9 SET STR=$JUSTIFY("",21)_SCDS
SET STR=STR_$JUSTIFY("",(61-$LENGTH(STR)))_SCDP
+10 DO WRT(STR,,,,0)
End DoDot:1
+11 QUIT
MT ; Means Test
+1 if $DATA(GMTSQIT)
QUIT
NEW %,%H,VAEL,VAERR
DO ELIG^VADPT
+2 if VAEL(9)'=""
DO WRT("Means Test",$PIECE(VAEL(9),"^",2),,,1)
+3 QUIT
NOK ; Next of Kin
+1 if $DATA(GMTSQIT)
QUIT
NEW %,%H,VAOA
SET VAOA("A")=1
DO OAD^VADPT
+2 if VAOA(9)=""
QUIT
IF VAOA(9)'=""
Begin DoDot:1
+3 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+4 WRITE ?16,"NOK: ",VAOA(9)
+5 if VAOA(10)'=""
WRITE ?51,"Relation: ",VAOA(10)
WRITE !
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+6 IF VAOA(1)'=""
Begin DoDot:1
+7 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+8 if VAOA(1)]""
WRITE ?21,VAOA(1)
+9 if VAOA(8)'=""
WRITE ?54,"Phone: ",VAOA(8)
WRITE !
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+10 IF VAOA(2)'=""
Begin DoDot:1
+11 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?21,VAOA(2),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+12 IF VAOA(3)'=""
Begin DoDot:1
+13 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?21,VAOA(3),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+14 IF VAOA(4)'=""
Begin DoDot:1
+15 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+16 WRITE ?21,VAOA(4)
if VAOA(5)
WRITE ", ",$PIECE(VAOA(5),U,2)
+17 if VAOA(6)
WRITE " ",VAOA(6)
WRITE !
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+18 QUIT
IEN ; Ineligible for Care Data
+1 if $DATA(GMTSQIT)
QUIT
NEW STR,REM,WRD,%,%H,VAEL,VAERR,GMTSDT
DO ELIG^VADPT
+2 IF +($PIECE(VAEL(5,1),U,1))>0
Begin DoDot:1
+3 SET GMTSDT=$$EDT^GMTSU($PIECE(VAEL(5,1),U,1))
+4 if $DATA(GMTSQIT)
QUIT
DO WRT("Ineligible date",GMTSDT,,,1)
+5 if $DATA(GMTSQIT)
QUIT
SET STR=$PIECE(VAEL(5,2),U,2)_" "_VAEL(5,3)_", "_$PIECE(VAEL(5,4),U,2)
+6 DO WRT("Inelig. TWX source",STR,,,1)
+7 if $DATA(GMTSQIT)
QUIT
SET STR=$GET(VAEL(5,5))
+8 FOR WRD=1:1
if $LENGTH(STR)'>58
QUIT
Begin DoDot:2
+9 SET REM=$PIECE(STR," ",($LENGTH(STR," ")-WRD),$LENGTH(STR," "))
+10 SET STR=$PIECE(STR," ",1,($LENGTH(STR," ")-(WRD+1)))
End DoDot:2
+11 if $LENGTH(STR)
DO WRT(($JUSTIFY("",21)_STR),,,,0)
+12 if $LENGTH(REM)
DO WRT(($JUSTIFY("",21)_REM),,,,0)
+13 if $LENGTH(VAEL(5,6))
DO WRT("Reason",$EXTRACT(VAEL(5,6),1,58),,,1)
End DoDot:1
+14 QUIT
+15 ;
WRT(CH1,CD1,CH2,CD2,FMT) ; Write/Save Demographic Line
+1 ;
+2 ; Input
+3 ; CH1 - Column 1 Header or Preformated Line
+4 ; CD1 - Column 1 Data
+5 ; CH2 - Column 2 Header
+6 ; CD2 - Column 2 Data
+7 ; FMT - Format in Columns 1=Yes 0=No
+8 ;
+9 ; If the variable GMTSDEMX exist, then the data will
+10 ; be saved in a global array instead of written to the
+11 ; screen. Global array:
+12 ;
+13 ; ^TMP("GMTSDEMO",$J,DFN,#)=<demographic text>
+14 if $DATA(GMTSQIT)
QUIT
NEW STR,BL,COL1,COL2,LN,LNLGTH
+15 SET LN=+($ORDER(^TMP("GMTSDEMO",$JOB,+($GET(DFN))," "),-1))+1
SET CH1=$GET(CH1)
SET CD1=$GET(CD1)
SET CH2=$GET(CH2)
SET CD2=$GET(CD2)
SET FMT=$GET(FMT)
+16 if +FMT'>0
SET STR=CH1
+17 IF +FMT>0
Begin DoDot:1
+18 SET LNLGTH=59
+19 if CH2=""
SET LNLGTH=78
+20 SET BL=$JUSTIFY("",(19-$LENGTH(CH1)))
SET CH1=BL_CH1_$SELECT($LENGTH(CH1)>0:": ",1:" ")
+21 SET BL=$JUSTIFY("",(((LNLGTH-$LENGTH(CH1))-$LENGTH(CH2))-2))
+22 SET CD1=$EXTRACT(CD1,1,$LENGTH(BL))
SET COL1=CH1_CD1
+23 SET BL=$JUSTIFY("",((59-$LENGTH(COL1))-$LENGTH(CH2)))
+24 SET CH2=BL_CH2_$SELECT($LENGTH(CH2)>0:": ",1:" ")
SET COL2=CH2_$EXTRACT(CD2,1,17)
+25 SET STR=COL1_COL2
End DoDot:1
+26 IF '$DATA(GMTSDEMX)
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE $GET(STR),!
+27 if $DATA(GMTSDEMX)
SET ^TMP("GMTSDEMO",$JOB,+($GET(DFN)),LN)=STR
+28 QUIT
+29 ;
ST ; Show ^TMP Global Array
+1 WRITE !!
NEW NN,NC
SET NN="^TMP(""GMTSDEMO"","_$JOB_","_+($GET(DFN))_")"
SET NC="^TMP(""GMTSDEMO"","_$JOB_","_+($GET(DFN))_","
FOR
SET NN=$QUERY(@NN)
if NN=""!(NN'[NC)
QUIT
WRITE !,@NN
+2 QUIT
END ; Clean-up and quit
+1 KILL I,VA,VADM,VAERR,VAOA,VASV,VAPA,VAPD,VAEL,SCD,SCDS,SCDP,FROM
+2 KILL GMI,TO,IX,X,Z
QUIT
