VAQDIS23 ;ALB/JFP,JRP - PDX, BUILDS DISPLAY ARRAY FOR MAS DATA ;01MAR93
;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
;
SCR1 ; -- Builds MAS DATA SCREEN 1, DEMOGRAPHICS
ROW0 ; -- Header line for display
S VAQLN=$$REPEAT^VAQUTL1("-",79)
S VAQCTR="< "_$S($P(VAQSEGND,"^",1)'="":$P(VAQSEGND,"^",1),1:"Segment Description Missing")_" >"
S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR) D TMP,BLANK^VAQDIS20
I $G(@XTRCT@("VALUE",2,.152,0))'="" D
.S X=$$SETSTR^VALM1("* Applicant is listed as (INELIGIBLE) for treatment","",1,79)
.D TMP
I $G(@XTRCT@("VALUE",2,.153,0))'="" D
.S X=$$SETSTR^VALM1("* Applicant is listed as (MISSING). NOTIFY APPROPRIATE PERSONNEL","",1,79)
.D TMP
D BLANK^VAQDIS20
S VAQLN=$$REPEAT^VAQUTL1(" ",79)
S VAQCTR=" -- PATIENT DEMOGRAPHICS -- "
S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR) D TMP,BLANK^VAQDIS20
K VAQLN,VAQCTR
ROW1 ;
S X=$$SETSTR^VALM1("Name: "_$G(@XTRCT@("VALUE",2,.01,0)),"",8,44)
S SSN=$$DASHSSN^VAQUTL99($G(@XTRCT@("VALUE",2,.09,0)))
S X=$$SETSTR^VALM1("SSN: "_SSN,X,45,16)
S X=$$SETSTR^VALM1("DOB: "_$G(@XTRCT@("VALUE",2,.03,0)),X,62,17)
D TMP K SSN
ROW2 ;
S SEQ=""
F J=1:1 S SEQ=$O(@XTRCT@("VALUE",2.01,.01,SEQ)) Q:SEQ="" D
.S:J=1 X=$$SETSTR^VALM1("Alias: "_$G(@XTRCT@("VALUE",2.01,.01,SEQ)),"",7,49)
.S:J'=1 X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",2.01,.01,SEQ)),"",14,49)
.S VAQASSN=$G(@XTRCT@("VALUE",2.01,1,SEQ))
.S:VAQASSN'="" VAQASSN=$$DASHSSN^VAQUTL99(VAQASSN)
.S X=$$SETSTR^VALM1(VAQASSN,X,50,29)
.D TMP
K J,SEQ,VAQASSN
ROW3 ;
S VAQTMP=$G(@XTRCT@("VALUE",2,.091,0))
S VAQINF=$S(VAQTMP="":"No remarks entered for this patient",1:VAQTMP)
S X=$$SETSTR^VALM1("Remark: "_VAQINF,"",5,79)
D TMP
K VAQTMP,VAQINF
ROW4 ;
S X=$$SETSTR^VALM1("Permanent Address:","",5,44)
S X=$$SETSTR^VALM1("Temporary Address:",X,45,34)
D TMP
;
PRMADD ; -- Permanent Address
K ADDR
S VAQTMP=1
F VAQX=.111,.112,.113 D Q:(VAQINF="")
.S VAQINF=$G(@XTRCT@("VALUE",2,VAQX,0))
.I ((VAQX=.111)&(VAQINF="")) S VAQINF="STREET ADDRESS UNKNOWN"
.Q:(VAQINF="")
.S ADDR(VAQTMP)=VAQINF
.S VAQTMP=VAQTMP+1
S CTY=$G(@XTRCT@("VALUE",2,.114,0))
S ZIP=$G(@XTRCT@("VALUE",2,.1112,0))
S STATE=$$STATE^VAQDIS20($G(@XTRCT@("VALUE",2,.115,0)))
S VAQINF=$S((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$S(STATE="":" ",1:", ")_STATE_" "_ZIP)
S ADDR(VAQTMP)=VAQINF
TMPADD ;Temporary address
K ADDRT
S VAQTMP=1
F VAQX=.1211,.1212,.1213 D Q:(VAQINF="")
.S VAQINF=$G(@XTRCT@("VALUE",2,VAQX,0))
.I ((VAQX=.1211)&(VAQINF="")) S VAQINF="STREET ADDRESS UNKNOWN"
.Q:(VAQINF="")
.S ADDRT(VAQTMP)=VAQINF
.S VAQTMP=VAQTMP+1
S CTY=$G(@XTRCT@("VALUE",2,.1214,0))
S ZIP=$G(@XTRCT@("VALUE",2,.12112,0))
S STATE=$$STATE^VAQDIS20($G(@XTRCT@("VALUE",2,.1215,0)))
S VAQINF=$S((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$S(STATE="":" ",1:", ")_STATE_" "_ZIP)
S ADDRT(VAQTMP)=VAQINF
D ADRLOAD
K ADDR,ADDRT,VAQTMP,VAQINF,VAQX,CTY,STATE,ZIP
;
ROW9 ; -- County
S CTYNUM=$G(@XTRCT@("VALUE",2,.117,0))
S COUNTY=$$COUNTY^VAQDIS20($G(@XTRCT@("VALUE",2,.115,0)),CTYNUM)
S VAQINF=COUNTY_" ("_CTYNUM_")"
S:(COUNTY="") VAQINF="UNKNOWN ("_CTYNUM_")"
S:((COUNTY="")&(CTYNUM="")) VAQINF="UNANSWERED"
S X=$$SETSTR^VALM1("County: "_VAQINF,"",2,43)
S CTYNUM=$G(@XTRCT@("VALUE",2,.12111,0))
S COUNTY=$$COUNTY^VAQDIS20($G(@XTRCT@("VALUE",2,.1215,0)),CTYNUM)
S VAQINF=COUNTY_" ("_CTYNUM_")"
S:(COUNTY="") VAQINF="UNKNOWN ("_CTYNUM_")"
S:((COUNTY="")&(CTYNUM="")) VAQINF="UNANSWERED"
S X=$$SETSTR^VALM1("County: "_VAQINF,X,44,35)
D TMP
K CTYNUM,COUNTY,VAQINF
ROW10 ; -- Phone
S X=$$SETSTR^VALM1("Phone: "_$G(@XTRCT@("VALUE",2,.131,0)),"",3,43)
S TPHONE=$G(@XTRCT@("VALUE",2,.1219,0))
S X=$$SETSTR^VALM1("Phone: "_$S(TPHONE'="":TPHONE,1:"NOT APPLICABLE"),X,45,34)
D TMP K TPHONE
ROW11 ; -- Work phone/temporary form-to
S X=$$SETSTR^VALM1("Office: "_$G(@XTRCT@("VALUE",2,.132,0)),"",2,43)
S VAQFROM=$G(@XTRCT@("VALUE",2,.1217,0))
S VAQTO=$G(@XTRCT@("VALUE",2,.1218,0))
S VAQFROMT=VAQFROM_"-"_VAQTO
I VAQFROMT="-" S VAQFROMT="NOT APPLICABLE"
S X=$$SETSTR^VALM1("From/To: "_VAQFROMT,X,43,36)
K VAQFROM,VAQTO,VAQFROMT
D TMP
EXIT ;
QUIT
;
ADRLOAD ; -- Loads addresses into display array
F VAQX=1:1:4 D
.S VAQINF=""
.S:($D(ADDR(VAQX))) VAQINF=$$SETSTR^VALM1(ADDR(VAQX),VAQINF,15,53)
.S:($D(ADDRT(VAQX))) VAQINF=$$SETSTR^VALM1(ADDRT(VAQX),VAQINF,54,25)
.Q:(VAQINF="")
.S VALMCNT=VALMCNT+1
.S @ROOT@(VALMCNT,0)=$E(VAQINF,1,79)
Q
;
TMP ; -- Sets up display array
S VALMCNT=VALMCNT+1
S @ROOT@(VALMCNT,0)=$E(X,1,79)
QUIT
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS23 4642 printed Sep 23, 2025@20:01:05 Page 2
VAQDIS23 ;ALB/JFP,JRP - PDX, BUILDS DISPLAY ARRAY FOR MAS DATA ;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
+2 ;
SCR1 ; -- Builds MAS DATA SCREEN 1, DEMOGRAPHICS
ROW0 ; -- Header line for display
+1 SET VAQLN=$$REPEAT^VAQUTL1("-",79)
+2 SET VAQCTR="< "_$SELECT($PIECE(VAQSEGND,"^",1)'="":$PIECE(VAQSEGND,"^",1),1:"Segment Description Missing")_" >"
+3 SET X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
DO TMP
DO BLANK^VAQDIS20
+4 IF $GET(@XTRCT@("VALUE",2,.152,0))'=""
Begin DoDot:1
+5 SET X=$$SETSTR^VALM1("* Applicant is listed as (INELIGIBLE) for treatment","",1,79)
+6 DO TMP
End DoDot:1
+7 IF $GET(@XTRCT@("VALUE",2,.153,0))'=""
Begin DoDot:1
+8 SET X=$$SETSTR^VALM1("* Applicant is listed as (MISSING). NOTIFY APPROPRIATE PERSONNEL","",1,79)
+9 DO TMP
End DoDot:1
+10 DO BLANK^VAQDIS20
+11 SET VAQLN=$$REPEAT^VAQUTL1(" ",79)
+12 SET VAQCTR=" -- PATIENT DEMOGRAPHICS -- "
+13 SET X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
DO TMP
DO BLANK^VAQDIS20
+14 KILL VAQLN,VAQCTR
ROW1 ;
+1 SET X=$$SETSTR^VALM1("Name: "_$GET(@XTRCT@("VALUE",2,.01,0)),"",8,44)
+2 SET SSN=$$DASHSSN^VAQUTL99($GET(@XTRCT@("VALUE",2,.09,0)))
+3 SET X=$$SETSTR^VALM1("SSN: "_SSN,X,45,16)
+4 SET X=$$SETSTR^VALM1("DOB: "_$GET(@XTRCT@("VALUE",2,.03,0)),X,62,17)
+5 DO TMP
KILL SSN
ROW2 ;
+1 SET SEQ=""
+2 FOR J=1:1
SET SEQ=$ORDER(@XTRCT@("VALUE",2.01,.01,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+3 if J=1
SET X=$$SETSTR^VALM1("Alias: "_$GET(@XTRCT@("VALUE",2.01,.01,SEQ)),"",7,49)
+4 if J'=1
SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",2.01,.01,SEQ)),"",14,49)
+5 SET VAQASSN=$GET(@XTRCT@("VALUE",2.01,1,SEQ))
+6 if VAQASSN'=""
SET VAQASSN=$$DASHSSN^VAQUTL99(VAQASSN)
+7 SET X=$$SETSTR^VALM1(VAQASSN,X,50,29)
+8 DO TMP
End DoDot:1
+9 KILL J,SEQ,VAQASSN
ROW3 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.091,0))
+2 SET VAQINF=$SELECT(VAQTMP="":"No remarks entered for this patient",1:VAQTMP)
+3 SET X=$$SETSTR^VALM1("Remark: "_VAQINF,"",5,79)
+4 DO TMP
+5 KILL VAQTMP,VAQINF
ROW4 ;
+1 SET X=$$SETSTR^VALM1("Permanent Address:","",5,44)
+2 SET X=$$SETSTR^VALM1("Temporary Address:",X,45,34)
+3 DO TMP
+4 ;
PRMADD ; -- Permanent Address
+1 KILL ADDR
+2 SET VAQTMP=1
+3 FOR VAQX=.111,.112,.113
Begin DoDot:1
+4 SET VAQINF=$GET(@XTRCT@("VALUE",2,VAQX,0))
+5 IF ((VAQX=.111)&(VAQINF=""))
SET VAQINF="STREET ADDRESS UNKNOWN"
+6 if (VAQINF="")
QUIT
+7 SET ADDR(VAQTMP)=VAQINF
+8 SET VAQTMP=VAQTMP+1
End DoDot:1
if (VAQINF="")
QUIT
+9 SET CTY=$GET(@XTRCT@("VALUE",2,.114,0))
+10 SET ZIP=$GET(@XTRCT@("VALUE",2,.1112,0))
+11 SET STATE=$$STATE^VAQDIS20($GET(@XTRCT@("VALUE",2,.115,0)))
+12 SET VAQINF=$SELECT((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$SELECT(STATE="":" ",1:", ")_STATE_" "_ZIP)
+13 SET ADDR(VAQTMP)=VAQINF
TMPADD ;Temporary address
+1 KILL ADDRT
+2 SET VAQTMP=1
+3 FOR VAQX=.1211,.1212,.1213
Begin DoDot:1
+4 SET VAQINF=$GET(@XTRCT@("VALUE",2,VAQX,0))
+5 IF ((VAQX=.1211)&(VAQINF=""))
SET VAQINF="STREET ADDRESS UNKNOWN"
+6 if (VAQINF="")
QUIT
+7 SET ADDRT(VAQTMP)=VAQINF
+8 SET VAQTMP=VAQTMP+1
End DoDot:1
if (VAQINF="")
QUIT
+9 SET CTY=$GET(@XTRCT@("VALUE",2,.1214,0))
+10 SET ZIP=$GET(@XTRCT@("VALUE",2,.12112,0))
+11 SET STATE=$$STATE^VAQDIS20($GET(@XTRCT@("VALUE",2,.1215,0)))
+12 SET VAQINF=$SELECT((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$SELECT(STATE="":" ",1:", ")_STATE_" "_ZIP)
+13 SET ADDRT(VAQTMP)=VAQINF
+14 DO ADRLOAD
+15 KILL ADDR,ADDRT,VAQTMP,VAQINF,VAQX,CTY,STATE,ZIP
+16 ;
ROW9 ; -- County
+1 SET CTYNUM=$GET(@XTRCT@("VALUE",2,.117,0))
+2 SET COUNTY=$$COUNTY^VAQDIS20($GET(@XTRCT@("VALUE",2,.115,0)),CTYNUM)
+3 SET VAQINF=COUNTY_" ("_CTYNUM_")"
+4 if (COUNTY="")
SET VAQINF="UNKNOWN ("_CTYNUM_")"
+5 if ((COUNTY="")&(CTYNUM=""))
SET VAQINF="UNANSWERED"
+6 SET X=$$SETSTR^VALM1("County: "_VAQINF,"",2,43)
+7 SET CTYNUM=$GET(@XTRCT@("VALUE",2,.12111,0))
+8 SET COUNTY=$$COUNTY^VAQDIS20($GET(@XTRCT@("VALUE",2,.1215,0)),CTYNUM)
+9 SET VAQINF=COUNTY_" ("_CTYNUM_")"
+10 if (COUNTY="")
SET VAQINF="UNKNOWN ("_CTYNUM_")"
+11 if ((COUNTY="")&(CTYNUM=""))
SET VAQINF="UNANSWERED"
+12 SET X=$$SETSTR^VALM1("County: "_VAQINF,X,44,35)
+13 DO TMP
+14 KILL CTYNUM,COUNTY,VAQINF
ROW10 ; -- Phone
+1 SET X=$$SETSTR^VALM1("Phone: "_$GET(@XTRCT@("VALUE",2,.131,0)),"",3,43)
+2 SET TPHONE=$GET(@XTRCT@("VALUE",2,.1219,0))
+3 SET X=$$SETSTR^VALM1("Phone: "_$SELECT(TPHONE'="":TPHONE,1:"NOT APPLICABLE"),X,45,34)
+4 DO TMP
KILL TPHONE
ROW11 ; -- Work phone/temporary form-to
+1 SET X=$$SETSTR^VALM1("Office: "_$GET(@XTRCT@("VALUE",2,.132,0)),"",2,43)
+2 SET VAQFROM=$GET(@XTRCT@("VALUE",2,.1217,0))
+3 SET VAQTO=$GET(@XTRCT@("VALUE",2,.1218,0))
+4 SET VAQFROMT=VAQFROM_"-"_VAQTO
+5 IF VAQFROMT="-"
SET VAQFROMT="NOT APPLICABLE"
+6 SET X=$$SETSTR^VALM1("From/To: "_VAQFROMT,X,43,36)
+7 KILL VAQFROM,VAQTO,VAQFROMT
+8 DO TMP
EXIT ;
+1 QUIT
+2 ;
ADRLOAD ; -- Loads addresses into display array
+1 FOR VAQX=1:1:4
Begin DoDot:1
+2 SET VAQINF=""
+3 if ($DATA(ADDR(VAQX)))
SET VAQINF=$$SETSTR^VALM1(ADDR(VAQX),VAQINF,15,53)
+4 if ($DATA(ADDRT(VAQX)))
SET VAQINF=$$SETSTR^VALM1(ADDRT(VAQX),VAQINF,54,25)
+5 if (VAQINF="")
QUIT
+6 SET VALMCNT=VALMCNT+1
+7 SET @ROOT@(VALMCNT,0)=$EXTRACT(VAQINF,1,79)
End DoDot:1
+8 QUIT
+9 ;
TMP ; -- Sets up display array
+1 SET VALMCNT=VALMCNT+1
+2 SET @ROOT@(VALMCNT,0)=$EXTRACT(X,1,79)
+3 QUIT
+4 ;
END ; -- End of code
+1 QUIT
