VAQDIS29 ;ALB/JFP,JRP - BUILDS DISPLAY ARRAY FOR (MAS DATA);3JUL91
;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
SCR6 ; -- SCREEN 6 (FIRST HALF)
; Calls VAQDIS30 for second half
R0 ; -- HEADER
D BLANK^VAQDIS20
S VAQLN=$$REPEAT^VAQUTL1(" ",79)
S VAQCTR=" -- MILITARY SERVICE -- "
S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
D TMP,BLANK^VAQDIS20
K VAQLN,VAQCTR
R1 ;
S X=$$SETSTR^VALM1("Service Branch","",5,22)
S X=$$SETSTR^VALM1("Service #",X,25,19)
S X=$$SETSTR^VALM1("Entered",X,47,12)
S X=$$SETSTR^VALM1("Separated",X,59,12)
S X=$$SETSTR^VALM1("Discharge",X,70,9)
D TMP
R2 ;
S X=$$SETSTR^VALM1("--------------","",5,22)
S X=$$SETSTR^VALM1("---------",X,25,19)
S X=$$SETSTR^VALM1("---------",X,47,12)
S X=$$SETSTR^VALM1("---------",X,59,12)
S X=$$SETSTR^VALM1("---------",X,70,9)
D TMP
R3 ;LAST SERVICE
S VAQCHK=$G(@XTRCT@("VALUE",2,.325,0))
S X=$$SETSTR^VALM1(VAQCHK,"",5,22)
S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",2,.328,0)),X,25,19)
S VAQTMP=$G(@XTRCT@("VALUE",2,.326,0)) D SCR6A
S X=$$SETSTR^VALM1(VAQINF,X,47,12)
S VAQTMP=$G(@XTRCT@("VALUE",2,.327,0)) D SCR6A
S X=$$SETSTR^VALM1(VAQINF,X,59,12)
S VAQTMP=$G(@XTRCT@("VALUE",2,.324,0)) D SCR6B
S X=$$SETSTR^VALM1(VAQINF,X,70,9)
D:VAQCHK'="" TMP
R4 ;NEXT TO LAST SERVICE
S VAQCHK=$G(@XTRCT@("VALUE",2,.3291,0))
S X=$$SETSTR^VALM1(VAQCHK,"",5,22)
S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",2,.3294,0)),X,25,19)
S VAQTMP=$G(@XTRCT@("VALUE",2,.3292,0)) D SCR6A
S X=$$SETSTR^VALM1(VAQINF,X,47,12)
S VAQTMP=$G(@XTRCT@("VALUE",2,.3293,0)) D SCR6A
S X=$$SETSTR^VALM1(VAQINF,X,59,12)
S VAQTMP=$G(@XTRCT@("VALUE",2,.329,0)) D SCR6B
S X=$$SETSTR^VALM1(VAQINF,X,70,9)
D:VAQCHK'="" TMP
R5 ;THIRD SERVICE
S VAQCHK=$G(@XTRCT@("VALUE",2,.3296,0))
S X=$$SETSTR^VALM1(VAQCHK,"",5,22)
S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",2,.3299,0)),X,25,19)
S VAQTMP=$G(@XTRCT@("VALUE",2,.3297,0)) D SCR6A
S X=$$SETSTR^VALM1(VAQINF,X,47,12)
S VAQTMP=$G(@XTRCT@("VALUE",2,.3298,0)) D SCR6A
S X=$$SETSTR^VALM1(VAQINF,X,59,12)
S VAQTMP=$G(@XTRCT@("VALUE",2,.3295,0)) D SCR6B
S X=$$SETSTR^VALM1(VAQINF,X,70,9)
D:VAQCHK'="" TMP
R6 ;
D BLANK^VAQDIS20
S X=$$SETSTR^VALM1("POW: "_$G(@XTRCT@("VALUE",2,.525,0)),"",13,12)
S VAQTMP=$G(@XTRCT@("VALUE",2,.527,0)) D SCR6A
S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
S VAQTMP=$G(@XTRCT@("VALUE",2,.528,0)) D SCR6A
S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,16)
S VAQINF="War: "_$$SCRWW($G(@XTRCT@("VALUE",2,.526,0)))
S X=$$SETSTR^VALM1(VAQINF,X,63,17)
D TMP
R7 ;
S X=$$SETSTR^VALM1("Combat: "_$G(@XTRCT@("VALUE",2,.5291,0)),"",10,15)
S VAQTMP=$G(@XTRCT@("VALUE",2,.5293,0)) D SCR6A
S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
S VAQTMP=$G(@XTRCT@("VALUE",2,.5294,0)) D SCR6A
S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,16)
S VAQINF="Loc: "_$$SCRWW($G(@XTRCT@("VALUE",2,.5292,0)))
S X=$$SETSTR^VALM1(VAQINF,X,63,17)
D TMP
R8 ;
S X=$$SETSTR^VALM1("Vietnam: "_$G(@XTRCT@("VALUE",2,.32101,0)),"",9,16)
S VAQTMP=$G(@XTRCT@("VALUE",2,.32104,0)) D SCR6A
S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
S VAQTMP=$G(@XTRCT@("VALUE",2,.32105,0)) D SCR6A
S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
D TMP
MAS6B ;SCREEN 6 (SECOND HALF)
D SCR6^VAQDIS30
EXIT K VAQCHK,VAQTMP,VAQINF
Q
TMP ; -- Sets up display array
S VALMCNT=VALMCNT+1
S @ROOT@(VALMCNT,0)=$E(X,1,79)
Q
SCR6A ;DATE CONVERSION
I VAQTMP="" S VAQINF="" QUIT
S VAQTMP=$$DATE^VAQUTL99(VAQTMP)
S VAQINF=$S(VAQTMP'="":$E(VAQTMP,4,5)_"/"_$E(VAQTMP,6,7)_"/"_$E(VAQTMP,2,3),1:VAQTMP)
Q
SCR6B I VAQTMP["OTHER THAN" S VAQINF="OTHER"
S VAQINF=$E(VAQTMP,1,12)
Q
SCRWW(LOC) ;SCREEN FOR WWI & WWII
S LOC=$G(LOC)
Q:($E(LOC,1,5)'="WORLD") LOC
S LOC="WWI"_$E(LOC,12,22)
Q $TR(LOC," ","")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS29 3743 printed Sep 23, 2025@20:01:11 Page 2
VAQDIS29 ;ALB/JFP,JRP - BUILDS DISPLAY ARRAY FOR (MAS DATA);3JUL91
+1 ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
SCR6 ; -- SCREEN 6 (FIRST HALF)
+1 ; Calls VAQDIS30 for second half
R0 ; -- HEADER
+1 DO BLANK^VAQDIS20
+2 SET VAQLN=$$REPEAT^VAQUTL1(" ",79)
+3 SET VAQCTR=" -- MILITARY SERVICE -- "
+4 SET X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
+5 DO TMP
DO BLANK^VAQDIS20
+6 KILL VAQLN,VAQCTR
R1 ;
+1 SET X=$$SETSTR^VALM1("Service Branch","",5,22)
+2 SET X=$$SETSTR^VALM1("Service #",X,25,19)
+3 SET X=$$SETSTR^VALM1("Entered",X,47,12)
+4 SET X=$$SETSTR^VALM1("Separated",X,59,12)
+5 SET X=$$SETSTR^VALM1("Discharge",X,70,9)
+6 DO TMP
R2 ;
+1 SET X=$$SETSTR^VALM1("--------------","",5,22)
+2 SET X=$$SETSTR^VALM1("---------",X,25,19)
+3 SET X=$$SETSTR^VALM1("---------",X,47,12)
+4 SET X=$$SETSTR^VALM1("---------",X,59,12)
+5 SET X=$$SETSTR^VALM1("---------",X,70,9)
+6 DO TMP
R3 ;LAST SERVICE
+1 SET VAQCHK=$GET(@XTRCT@("VALUE",2,.325,0))
+2 SET X=$$SETSTR^VALM1(VAQCHK,"",5,22)
+3 SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",2,.328,0)),X,25,19)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.326,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1(VAQINF,X,47,12)
+6 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.327,0))
DO SCR6A
+7 SET X=$$SETSTR^VALM1(VAQINF,X,59,12)
+8 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.324,0))
DO SCR6B
+9 SET X=$$SETSTR^VALM1(VAQINF,X,70,9)
+10 if VAQCHK'=""
DO TMP
R4 ;NEXT TO LAST SERVICE
+1 SET VAQCHK=$GET(@XTRCT@("VALUE",2,.3291,0))
+2 SET X=$$SETSTR^VALM1(VAQCHK,"",5,22)
+3 SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",2,.3294,0)),X,25,19)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3292,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1(VAQINF,X,47,12)
+6 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3293,0))
DO SCR6A
+7 SET X=$$SETSTR^VALM1(VAQINF,X,59,12)
+8 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.329,0))
DO SCR6B
+9 SET X=$$SETSTR^VALM1(VAQINF,X,70,9)
+10 if VAQCHK'=""
DO TMP
R5 ;THIRD SERVICE
+1 SET VAQCHK=$GET(@XTRCT@("VALUE",2,.3296,0))
+2 SET X=$$SETSTR^VALM1(VAQCHK,"",5,22)
+3 SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",2,.3299,0)),X,25,19)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3297,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1(VAQINF,X,47,12)
+6 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3298,0))
DO SCR6A
+7 SET X=$$SETSTR^VALM1(VAQINF,X,59,12)
+8 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3295,0))
DO SCR6B
+9 SET X=$$SETSTR^VALM1(VAQINF,X,70,9)
+10 if VAQCHK'=""
DO TMP
R6 ;
+1 DO BLANK^VAQDIS20
+2 SET X=$$SETSTR^VALM1("POW: "_$GET(@XTRCT@("VALUE",2,.525,0)),"",13,12)
+3 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.527,0))
DO SCR6A
+4 SET X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
+5 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.528,0))
DO SCR6A
+6 SET X=$$SETSTR^VALM1("To: "_VAQINF,X,46,16)
+7 SET VAQINF="War: "_$$SCRWW($GET(@XTRCT@("VALUE",2,.526,0)))
+8 SET X=$$SETSTR^VALM1(VAQINF,X,63,17)
+9 DO TMP
R7 ;
+1 SET X=$$SETSTR^VALM1("Combat: "_$GET(@XTRCT@("VALUE",2,.5291,0)),"",10,15)
+2 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.5293,0))
DO SCR6A
+3 SET X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.5294,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1("To: "_VAQINF,X,46,16)
+6 SET VAQINF="Loc: "_$$SCRWW($GET(@XTRCT@("VALUE",2,.5292,0)))
+7 SET X=$$SETSTR^VALM1(VAQINF,X,63,17)
+8 DO TMP
R8 ;
+1 SET X=$$SETSTR^VALM1("Vietnam: "_$GET(@XTRCT@("VALUE",2,.32101,0)),"",9,16)
+2 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.32104,0))
DO SCR6A
+3 SET X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
+4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.32105,0))
DO SCR6A
+5 SET X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
+6 DO TMP
MAS6B ;SCREEN 6 (SECOND HALF)
+1 DO SCR6^VAQDIS30
EXIT KILL VAQCHK,VAQTMP,VAQINF
+1 QUIT
TMP ; -- Sets up display array
+1 SET VALMCNT=VALMCNT+1
+2 SET @ROOT@(VALMCNT,0)=$EXTRACT(X,1,79)
+3 QUIT
SCR6A ;DATE CONVERSION
+1 IF VAQTMP=""
SET VAQINF=""
QUIT
+2 SET VAQTMP=$$DATE^VAQUTL99(VAQTMP)
+3 SET VAQINF=$SELECT(VAQTMP'="":$EXTRACT(VAQTMP,4,5)_"/"_$EXTRACT(VAQTMP,6,7)_"/"_$EXTRACT(VAQTMP,2,3),1:VAQTMP)
+4 QUIT
SCR6B IF VAQTMP["OTHER THAN"
SET VAQINF="OTHER"
+1 SET VAQINF=$EXTRACT(VAQTMP,1,12)
+2 QUIT
SCRWW(LOC) ;SCREEN FOR WWI & WWII
+1 SET LOC=$GET(LOC)
+2 if ($EXTRACT(LOC,1,5)'="WORLD")
QUIT LOC
+3 SET LOC="WWI"_$EXTRACT(LOC,12,22)
+4 QUIT $TRANSLATE(LOC," ","")
