- DVBHQM12 ;ISC-ALBANY/PKE/JLU-create mail message ;9/28/88@0800
- ;;4.0;HINQ;**4,49**;03/25/92
- ;
- LIN Q:CT>100 S CT=CT+1,A1=A_CT_",0)",@A1=T1 Q
- DD S:Y Y=$S($E(Y,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),"^",Y[".") S:$L(Y)=10 Y=Y_" " Q
- ;
- BLOCK I $D(DVBCN) S T1=" Claim Number = "_DVBCN D LIN
- B I $D(DVBSN) S T1=" Service Number = " F I=2:1 Q:'$D(DVBSN(I)) S T1=T1_DVBSN(I)_" "
- I $D(DVBSN) D LIN
- I $D(DVBFL) S T1=" Folder Location = "_DVBFL D LIN
- I $D(DVBBIR),$P(DVBBIR,U,18) S T1=$P(DVBBIR,U,18) D CHR S T1="C.H.Record Location = "_$S(Y:Y,1:T1) D LIN
- I $D(DVBPOA) S T1=" Power of Attorney = "_$G(DVBPOA) D LIN
- S T1=1
- I $D(DVBPOW) S T1=$E(BL,1,9)_" POW = "_$S(DVBPOW=0:"No period of rec.",DVBPOW=1:"30 days or fewer",DVBPOW=2:"more than 30 days",DVBPOW=" ":"Not applicable",1:DVBPOW)
- I $D(DVBPOWD) S T1=$S('+T1:T1_" "_DVBPOWD,1:"POW "_DVBPOWD)
- I 'T1 D LIN K T1
- I $D(DVBTOTAS) S T1=" Total Active Svc = "_DVBTOTAS D LIN
- ;
- ;DVB*4*49 - Disability Indicator no longer being sent
- I $D(DVBBIR) S T1="INDICATORS( Active Duty Training "_$S($P(DVBBIR,U,24)["Y":"YES",1:"NO ")
- S T1=T1_" Homeless Veteran "_$S($P(DVBBIR,U,30)["Y":"YES",$P(DVBBIR,U,30)="H":"YES",1:"NO ")_")" D LIN
- ;
- S T1="" D LIN
- S T1=" Service data - VBA" D LIN
- S T1="--------------------------------------------------------------" D LIN
- ;
- ;DVB*4*49 - all military service data should be in the BIRLS portion of
- ;the response message, since that is where up to three episodes of
- ;service can be stored, and the statistical segment information
- ;would just duplicate the BIRLs segment info, due to there being no
- ;indication of which database is being used. So, if there is data
- ;in DVBBOS(2), DVBEOD(2), or DVBRAD(2), kill the 1st node of these arrs.
- I $G(DVBBOS(2))]"" K DVBBOS(1)
- I +$G(DVBEOD(2))>0 K DVBEOD(1)
- I +$G(DVBRAD(2))>0 K DVBRAD(1)
- ;
- I $D(DVBBOS) D BOS F I=2:1 Q:'$D(DVBBOS(I)) S Y=DVBBOS(I) D XBOS S T1=T1_Y
- I $D(DVBBOS) D LIN
- ;
- I $D(DVBEOD) S T1=" EOD: " F I=0:0 S I=$O(DVBEOD(I)) D:I="" LIN Q:I="" D CEOD S T1=T1_Y_" "
- I $D(DVBRAD) S T1=" RAD: " F I=0:0 S I=$O(DVBRAD(I)) D:I="" LIN Q:I="" D CRAD S T1=T1_Y_" "
- S T1="" D LIN
- ;
- Q
- ;
- BOS S T1=" Svc Branch: " I $D(DVBBOS(1)) S Y=DVBBOS(1) D XBOS S T1=T1_Y
- Q
- XBOS ;DVB*4*49 - BOS codes have changed
- N DVBY
- Q:Y']""
- S Y=$TR(Y," ")
- S Y=$$UPPER^VALM1(Y)
- N YY
- S YY=Y
- S Y=$S(Y="ARMY":"Army",Y="NAVY":"Navy",Y="AF":"Air Force",Y="AFA":"Air Force Acad",Y="AFC":"Air Force Civilian",Y="AFR":"Air Force Res",Y="ANG":"Air Nat Guard",Y="AAC":"Army Air Corps/Army Air Force",1:Y)
- I YY=Y S Y=$S(Y="AACV":"Amer. Airlines Civilian",Y="ANC":"Army Nurse Corps",Y="ANCF":"ANC Fem Civ-Bataan/Correg.",Y="AFS":"Civilians AFS/WWII Overseas",Y="ARNG":"Army Nat Guard",1:Y)
- I YY=Y S Y=$S(Y="CG":"Coast Guard",Y="CGA":"CG Acad",Y="CGR":"CG Res",Y="CGS":"Coast & Geodetic Survey",Y="CPDW":"Civilians PNAB Wake/WWII",Y="ESSA":"Envir Science Svcs Admin",Y="GCS":"Guer Combination Svc",1:Y)
- I YY=Y S Y=$S(Y="HDAV":"Hon Disch Members Amer Vol Guard",Y="MC":"Marine Corps",Y="MCR":"MC Res",Y="MM":"Merchant Marine",1:Y)
- I YY=Y S Y=$S(Y="NA":"Naval Acad",Y="NNC":"Navy Nurse Corps",Y="NOAA":"Nat Ocean & Atmospher Admin",Y="NR":"Navy Res",Y="O":"Other",Y="OTH":"Other",Y="OSSC":"Civ OSS Secret Intel",1:Y)
- I YY=Y S Y=$S(Y="PACC":"Pan Am Civ contract Overseas WWII",Y="POUS":"Phil Army ordered US Arm Forces",Y="PCA":"Phillip Comn Army",Y="PG":"Phillip Guerilla",Y="PGCS":"Phil Guer & Comb Svc",1:Y)
- I YY=Y S Y=$S(Y="PRS":"Phillip Reg Scout & Comb Svc",Y="PHS":"Public Health Scv",Y="QC":"Quartermaster Corps Keswick/Correg/WWII",1:Y)
- I YY=Y S Y=$S(Y="RPS":"Reg Phillip Scout",Y="SPS":"Spec Phillip Scout",Y="USAR":"US Army Res",Y="USCV":"US Civ Vol Act Defense Bataan",1:Y)
- S Y=$S(Y="USMA":"US Mil Acad",Y="USMS":"US Merch Seamen Blockship Op Mulberry",Y="WASP":"Womens AF Svc Pilots",Y="WAAC":"Womens Army Aux Corps",Y="WAC":"Womens Army Corps",Y="WRM":"Womens Res of Marines",1:Y)
- S DVBY=" " ;sized to match widest char service value
- S Y=Y_$E(DVBY,$L(Y)+1,22)
- Q
- ;
- CEOD I I=1 S M=$E(DVBEOD(1),1,2) D MM^DVBHQM11 S Y=M_" "_$E(DVBEOD(1),3,4)_","_$E(DVBEOD(1),5,8) Q
- I DVBEOD(I)?7N S Y=DVBEOD(I) D DD
- E S Y=""
- Q
- ;
- CRAD I I=1 S M=$E(DVBRAD(1),1,2) D MM^DVBHQM11 S Y=M_" "_$E(DVBRAD(1),3,4)_","_$E(DVBRAD(1),5,8) Q
- I DVBRAD(I)?7N S Y=DVBRAD(I) D DD
- E S Y=""
- Q
- CHR S Y=0,Y=$O(^DIC(4,"D",+$P(DVBBIR,U,18),Y)) I Y S Y=$S($D(^DIC(4,Y,0)):$P(^DIC(4,Y,99),U,1)_" - "_$P(^(0),U),1:"")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHQM12 4721 printed Feb 18, 2025@23:25:04 Page 2
- DVBHQM12 ;ISC-ALBANY/PKE/JLU-create mail message ;9/28/88@0800
- +1 ;;4.0;HINQ;**4,49**;03/25/92
- +2 ;
- LIN if CT>100
- QUIT
- SET CT=CT+1
- SET A1=A_CT_",0)"
- SET @A1=T1
- QUIT
- DD if Y
- SET Y=$SELECT($EXTRACT(Y,4,5):$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$EXTRACT(Y,4,5))_" ",1:"")_$SELECT($EXTRACT(Y,6,7):+$EXTRACT(Y,6,7)_",",1:"")_($EXTRACT(Y,1,3)+1700)_$PIECE("@"_$EXTRACT(Y_0,9,10)_":"_...
- ... $EXTRACT(Y_"000",11,12),"^",Y[".")
- if $LENGTH(Y)=10
- SET Y=Y_" "
- QUIT
- +1 ;
- BLOCK IF $DATA(DVBCN)
- SET T1=" Claim Number = "_DVBCN
- DO LIN
- B IF $DATA(DVBSN)
- SET T1=" Service Number = "
- FOR I=2:1
- if '$DATA(DVBSN(I))
- QUIT
- SET T1=T1_DVBSN(I)_" "
- +1 IF $DATA(DVBSN)
- DO LIN
- +2 IF $DATA(DVBFL)
- SET T1=" Folder Location = "_DVBFL
- DO LIN
- +3 IF $DATA(DVBBIR)
- IF $PIECE(DVBBIR,U,18)
- SET T1=$PIECE(DVBBIR,U,18)
- DO CHR
- SET T1="C.H.Record Location = "_$SELECT(Y:Y,1:T1)
- DO LIN
- +4 IF $DATA(DVBPOA)
- SET T1=" Power of Attorney = "_$GET(DVBPOA)
- DO LIN
- +5 SET T1=1
- +6 IF $DATA(DVBPOW)
- SET T1=$EXTRACT(BL,1,9)_" POW = "_$SELECT(DVBPOW=0:"No period of rec.",DVBPOW=1:"30 days or fewer",DVBPOW=2:"more than 30 days",DVBPOW=" ":"Not applicable",1:DVBPOW)
- +7 IF $DATA(DVBPOWD)
- SET T1=$SELECT('+T1:T1_" "_DVBPOWD,1:"POW "_DVBPOWD)
- +8 IF 'T1
- DO LIN
- KILL T1
- +9 IF $DATA(DVBTOTAS)
- SET T1=" Total Active Svc = "_DVBTOTAS
- DO LIN
- +10 ;
- +11 ;DVB*4*49 - Disability Indicator no longer being sent
- +12 IF $DATA(DVBBIR)
- SET T1="INDICATORS( Active Duty Training "_$SELECT($PIECE(DVBBIR,U,24)["Y":"YES",1:"NO ")
- +13 SET T1=T1_" Homeless Veteran "_$SELECT($PIECE(DVBBIR,U,30)["Y":"YES",$PIECE(DVBBIR,U,30)="H":"YES",1:"NO ")_")"
- DO LIN
- +14 ;
- +15 SET T1=""
- DO LIN
- +16 SET T1=" Service data - VBA"
- DO LIN
- +17 SET T1="--------------------------------------------------------------"
- DO LIN
- +18 ;
- +19 ;DVB*4*49 - all military service data should be in the BIRLS portion of
- +20 ;the response message, since that is where up to three episodes of
- +21 ;service can be stored, and the statistical segment information
- +22 ;would just duplicate the BIRLs segment info, due to there being no
- +23 ;indication of which database is being used. So, if there is data
- +24 ;in DVBBOS(2), DVBEOD(2), or DVBRAD(2), kill the 1st node of these arrs.
- +25 IF $GET(DVBBOS(2))]""
- KILL DVBBOS(1)
- +26 IF +$GET(DVBEOD(2))>0
- KILL DVBEOD(1)
- +27 IF +$GET(DVBRAD(2))>0
- KILL DVBRAD(1)
- +28 ;
- +29 IF $DATA(DVBBOS)
- DO BOS
- FOR I=2:1
- if '$DATA(DVBBOS(I))
- QUIT
- SET Y=DVBBOS(I)
- DO XBOS
- SET T1=T1_Y
- +30 IF $DATA(DVBBOS)
- DO LIN
- +31 ;
- +32 IF $DATA(DVBEOD)
- SET T1=" EOD: "
- FOR I=0:0
- SET I=$ORDER(DVBEOD(I))
- if I=""
- DO LIN
- if I=""
- QUIT
- DO CEOD
- SET T1=T1_Y_" "
- +33 IF $DATA(DVBRAD)
- SET T1=" RAD: "
- FOR I=0:0
- SET I=$ORDER(DVBRAD(I))
- if I=""
- DO LIN
- if I=""
- QUIT
- DO CRAD
- SET T1=T1_Y_" "
- +34 SET T1=""
- DO LIN
- +35 ;
- +36 QUIT
- +37 ;
- BOS SET T1=" Svc Branch: "
- IF $DATA(DVBBOS(1))
- SET Y=DVBBOS(1)
- DO XBOS
- SET T1=T1_Y
- +1 QUIT
- XBOS ;DVB*4*49 - BOS codes have changed
- +1 NEW DVBY
- +2 if Y']""
- QUIT
- +3 SET Y=$TRANSLATE(Y," ")
- +4 SET Y=$$UPPER^VALM1(Y)
- +5 NEW YY
- +6 SET YY=Y
- +7 SET Y=$SELECT(Y="ARMY":"Army",Y="NAVY":"Navy",Y="AF":"Air Force",Y="AFA":"Air Force Acad",Y="AFC":"Air Force Civilian",Y="AFR":"Air Force Res",Y="ANG":"Air Nat Guard",Y="AAC":"Army Air Corps/Army Air Force",1:Y)
- +8 IF YY=Y
- SET Y=$SELECT(Y="AACV":"Amer. Airlines Civilian",Y="ANC":"Army Nurse Corps",Y="ANCF":"ANC Fem Civ-Bataan/Correg.",Y="AFS":"Civilians AFS/WWII Overseas",Y="ARNG":"Army Nat Guard",1:Y)
- +9 IF YY=Y
- SET Y=$SELECT(Y="CG":"Coast Guard",Y="CGA":"CG Acad",Y="CGR":"CG Res",Y="CGS":"Coast & Geodetic Survey",Y="CPDW":"Civilians PNAB Wake/WWII",Y="ESSA":"Envir Science Svcs Admin",Y="GCS":"Guer Combination Svc",1:Y)
- +10 IF YY=Y
- SET Y=$SELECT(Y="HDAV":"Hon Disch Members Amer Vol Guard",Y="MC":"Marine Corps",Y="MCR":"MC Res",Y="MM":"Merchant Marine",1:Y)
- +11 IF YY=Y
- SET Y=$SELECT(Y="NA":"Naval Acad",Y="NNC":"Navy Nurse Corps",Y="NOAA":"Nat Ocean & Atmospher Admin",Y="NR":"Navy Res",Y="O":"Other",Y="OTH":"Other",Y="OSSC":"Civ OSS Secret Intel",1:Y)
- +12 IF YY=Y
- SET Y=$SELECT(Y="PACC":"Pan Am Civ contract Overseas WWII",Y="POUS":"Phil Army ordered US Arm Forces",Y="PCA":"Phillip Comn Army",Y="PG":"Phillip Guerilla",Y="PGCS":"Phil Guer & Comb Svc",1:Y)
- +13 IF YY=Y
- SET Y=$SELECT(Y="PRS":"Phillip Reg Scout & Comb Svc",Y="PHS":"Public Health Scv",Y="QC":"Quartermaster Corps Keswick/Correg/WWII",1:Y)
- +14 IF YY=Y
- SET Y=$SELECT(Y="RPS":"Reg Phillip Scout",Y="SPS":"Spec Phillip Scout",Y="USAR":"US Army Res",Y="USCV":"US Civ Vol Act Defense Bataan",1:Y)
- +15 SET Y=$SELECT(Y="USMA":"US Mil Acad",Y="USMS":"US Merch Seamen Blockship Op Mulberry",Y="WASP":"Womens AF Svc Pilots",Y="WAAC":"Womens Army Aux Corps",Y="WAC":"Womens Army Corps",Y="WRM":"Womens Res of Marines",1:Y)
- +16 ;sized to match widest char service value
- SET DVBY=" "
- +17 SET Y=Y_$EXTRACT(DVBY,$LENGTH(Y)+1,22)
- +18 QUIT
- +19 ;
- CEOD IF I=1
- SET M=$EXTRACT(DVBEOD(1),1,2)
- DO MM^DVBHQM11
- SET Y=M_" "_$EXTRACT(DVBEOD(1),3,4)_","_$EXTRACT(DVBEOD(1),5,8)
- QUIT
- +1 IF DVBEOD(I)?7N
- SET Y=DVBEOD(I)
- DO DD
- +2 IF '$TEST
- SET Y=""
- +3 QUIT
- +4 ;
- CRAD IF I=1
- SET M=$EXTRACT(DVBRAD(1),1,2)
- DO MM^DVBHQM11
- SET Y=M_" "_$EXTRACT(DVBRAD(1),3,4)_","_$EXTRACT(DVBRAD(1),5,8)
- QUIT
- +1 IF DVBRAD(I)?7N
- SET Y=DVBRAD(I)
- DO DD
- +2 IF '$TEST
- SET Y=""
- +3 QUIT
- CHR SET Y=0
- SET Y=$ORDER(^DIC(4,"D",+$PIECE(DVBBIR,U,18),Y))
- IF Y
- SET Y=$SELECT($DATA(^DIC(4,Y,0)):$PIECE(^DIC(4,Y,99),U,1)_" - "_$PIECE(^(0),U),1:"")
- +1 QUIT