- 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 Jan 18, 2025@02:58:26 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