source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDIS23.m@ 1397

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