VAQDIS32 ;ALB/JFP,JRP - BUILDS DISPLAY ARRAY FOR (MAS DATA);3JUL91
;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
SCR10 ;SCREEN 10 of MAS
R0 ; -- HEADER
D BLANK^VAQDIS20
S VAQLN=$$REPEAT^VAQUTL1(" ",79)
S VAQCTR=" -- INELIGIBLE/MISSING DATA -- "
S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
D TMP,BLANK^VAQDIS20
K VAQLN,VAQCTR
R1 ;
S VAQINF=$G(@XTRCT@("VALUE",2,.152,0))
S VAQDTE=$S(VAQINF="":0,1:1)
S:(VAQINF="") VAQINF="NOT APPLICABLE"
S X=$$SETSTR^VALM1("Ineligible Date: "_VAQINF,"",6,41)
S VAQTMP=$G(@XTRCT@("VALUE",2,.1651,0)) D SCR
S X=$$SETSTR^VALM1("TWX Source: "_VAQINF,X,48,31)
D TMP
R2 ;
S VAQTMP=$G(@XTRCT@("VALUE",2,.1653,0)) D SCR
S X=$$SETSTR^VALM1("TWX City: "_VAQINF,"",13,35)
S VAQTMP=$G(@XTRCT@("VALUE",2,.1654,0)) D SCR
S X=$$SETSTR^VALM1("TWX State: "_VAQINF,X,49,30)
D TMP
R3 ;
S VAQINF=$G(@XTRCT@("VALUE",2,.307,0))
S:('VAQDTE) VAQINF="NOT APPLICABLE"
S:((VAQDTE)&(VAQINF="")) VAQINF="UNSPECIFIED"
S X=$$SETSTR^VALM1("Reason: "_VAQINF,"",15,64)
D TMP
R4 ;
S VAQTMP=$G(@XTRCT@("VALUE",2,.1656,0)) D SCR
S X=$$SETSTR^VALM1("VARO Decision: "_VAQINF,"",8,71)
D TMP
R5 ;
S VAQINF=$G(@XTRCT@("VALUE",2,.153,0))
S VAQDTE=$S(VAQINF="":0,1:1)
S:(VAQINF="") VAQINF="NOT APPLICABLE"
S X=$$SETSTR^VALM1("Missing Date: "_VAQINF,"",9,38)
S VAQTMP=$G(@XTRCT@("VALUE",2,.1657,0)) D SCR
S X=$$SETSTR^VALM1("TWX Source: "_VAQINF,X,48,31)
D TMP
R6 ;
S VAQTMP=$G(@XTRCT@("VALUE",2,.1658,0)) D SCR
S X=$$SETSTR^VALM1("TWX City: "_VAQINF,"",13,35)
S VAQTMP=$G(@XTRCT@("VALUE",2,.1659,0)) D SCR
S X=$$SETSTR^VALM1("TWX State: "_VAQINF,X,49,30)
D TMP
R7 ;
I ('VAQDTE) S X=$$SETSTR^VALM1("Reason: NOT APPLICABLE","",15,64) D TMP G EXIT
S SEQ=""
I ($O(@XTRCT@("VALUE",2.16,.01,SEQ))="") S X=$$SETSTR^VALM1("Reason: UNSPECIFIED","",15,64) D TMP G EXIT
K ^UTILITY($J,"W")
S SEQ=""
F S SEQ=$O(@XTRCT@("VALUE",2.16,.01,SEQ)) Q:(SEQ="") D
.S X=$G(@XTRCT@("VALUE",2.16,.01,SEQ))
.S DIWL=23
.S DIWR=79
.S DIWF=""
.D ^DIWP
S SEQ=0
F S SEQ=$O(^UTILITY($J,"W",23,SEQ)) Q:(SEQ="") D
.S X=$G(^UTILITY($J,"W",23,SEQ,0))
.S X=$$SETSTR^VALM1(X,"",23,56)
.I (SEQ=1) S X=$$SETSTR^VALM1("Reason: ",X,15,8)
.D TMP
;
EXIT K VAQLN,VAQCTR,VAQINF,VAQTMP,X,SEQ,VAQDTE
K ^UTILITY($J,"W"),DIWL,DIWR,DIWF
QUIT
;
TMP ; -- Sets up line
S VALMCNT=VALMCNT+1
S @ROOT@(VALMCNT,0)=$E(X,1,79)
QUIT
;
SCR I ('VAQDTE) S VAQINF="NOT APPLICABLE" Q
S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
QUIT
;
END ;End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS32 2527 printed Oct 16, 2024@18:26:17 Page 2
VAQDIS32 ;ALB/JFP,JRP - BUILDS DISPLAY ARRAY FOR (MAS DATA);3JUL91
+1 ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
SCR10 ;SCREEN 10 of MAS
R0 ; -- HEADER
+1 DO BLANK^VAQDIS20
+2 SET VAQLN=$$REPEAT^VAQUTL1(" ",79)
+3 SET VAQCTR=" -- INELIGIBLE/MISSING DATA -- "
+4 SET X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
+5 DO TMP
DO BLANK^VAQDIS20
+6 KILL VAQLN,VAQCTR
R1 ;
+1 SET VAQINF=$GET(@XTRCT@("VALUE",2,.152,0))
+2 SET VAQDTE=$SELECT(VAQINF="":0,1:1)
+3 if (VAQINF="")
SET VAQINF="NOT APPLICABLE"
+4 SET X=$$SETSTR^VALM1("Ineligible Date: "_VAQINF,"",6,41)
+5 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.1651,0))
DO SCR
+6 SET X=$$SETSTR^VALM1("TWX Source: "_VAQINF,X,48,31)
+7 DO TMP
R2 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.1653,0))
DO SCR
+2 SET X=$$SETSTR^VALM1("TWX City: "_VAQINF,"",13,35)
+3 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.1654,0))
DO SCR
+4 SET X=$$SETSTR^VALM1("TWX State: "_VAQINF,X,49,30)
+5 DO TMP
R3 ;
+1 SET VAQINF=$GET(@XTRCT@("VALUE",2,.307,0))
+2 if ('VAQDTE)
SET VAQINF="NOT APPLICABLE"
+3 if ((VAQDTE)&(VAQINF=""))
SET VAQINF="UNSPECIFIED"
+4 SET X=$$SETSTR^VALM1("Reason: "_VAQINF,"",15,64)
+5 DO TMP
R4 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.1656,0))
DO SCR
+2 SET X=$$SETSTR^VALM1("VARO Decision: "_VAQINF,"",8,71)
+3 DO TMP
R5 ;
+1 SET VAQINF=$GET(@XTRCT@("VALUE",2,.153,0))
+2 SET VAQDTE=$SELECT(VAQINF="":0,1:1)
+3 if (VAQINF="")
SET VAQINF="NOT APPLICABLE"
+4 SET X=$$SETSTR^VALM1("Missing Date: "_VAQINF,"",9,38)
+5 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.1657,0))
DO SCR
+6 SET X=$$SETSTR^VALM1("TWX Source: "_VAQINF,X,48,31)
+7 DO TMP
R6 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.1658,0))
DO SCR
+2 SET X=$$SETSTR^VALM1("TWX City: "_VAQINF,"",13,35)
+3 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.1659,0))
DO SCR
+4 SET X=$$SETSTR^VALM1("TWX State: "_VAQINF,X,49,30)
+5 DO TMP
R7 ;
+1 IF ('VAQDTE)
SET X=$$SETSTR^VALM1("Reason: NOT APPLICABLE","",15,64)
DO TMP
GOTO EXIT
+2 SET SEQ=""
+3 IF ($ORDER(@XTRCT@("VALUE",2.16,.01,SEQ))="")
SET X=$$SETSTR^VALM1("Reason: UNSPECIFIED","",15,64)
DO TMP
GOTO EXIT
+4 KILL ^UTILITY($JOB,"W")
+5 SET SEQ=""
+6 FOR
SET SEQ=$ORDER(@XTRCT@("VALUE",2.16,.01,SEQ))
if (SEQ="")
QUIT
Begin DoDot:1
+7 SET X=$GET(@XTRCT@("VALUE",2.16,.01,SEQ))
+8 SET DIWL=23
+9 SET DIWR=79
+10 SET DIWF=""
+11 DO ^DIWP
End DoDot:1
+12 SET SEQ=0
+13 FOR
SET SEQ=$ORDER(^UTILITY($JOB,"W",23,SEQ))
if (SEQ="")
QUIT
Begin DoDot:1
+14 SET X=$GET(^UTILITY($JOB,"W",23,SEQ,0))
+15 SET X=$$SETSTR^VALM1(X,"",23,56)
+16 IF (SEQ=1)
SET X=$$SETSTR^VALM1("Reason: ",X,15,8)
+17 DO TMP
End DoDot:1
+18 ;
EXIT KILL VAQLN,VAQCTR,VAQINF,VAQTMP,X,SEQ,VAQDTE
+1 KILL ^UTILITY($JOB,"W"),DIWL,DIWR,DIWF
+2 QUIT
+3 ;
TMP ; -- Sets up line
+1 SET VALMCNT=VALMCNT+1
+2 SET @ROOT@(VALMCNT,0)=$EXTRACT(X,1,79)
+3 QUIT
+4 ;
SCR IF ('VAQDTE)
SET VAQINF="NOT APPLICABLE"
QUIT
+1 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
+2 QUIT
+3 ;
END ;End of code
+1 QUIT
