127 lines
4.4 KiB
Mathematica
127 lines
4.4 KiB
Mathematica
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
|