- 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 Apr 23, 2025@18:39:35 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
