- 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 Jan 18, 2025@03:26:13 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," ","")