| 1 | VAQDIS23 ;ALB/JFP,JRP - PDX, BUILDS DISPLAY ARRAY FOR MAS DATA ;01MAR93
|
---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
|
---|
| 3 | ;
|
---|
| 4 | SCR1 ; -- Builds MAS DATA SCREEN 1, DEMOGRAPHICS
|
---|
| 5 | ROW0 ; -- Header line for display
|
---|
| 6 | S VAQLN=$$REPEAT^VAQUTL1("-",79)
|
---|
| 7 | S VAQCTR="< "_$S($P(VAQSEGND,"^",1)'="":$P(VAQSEGND,"^",1),1:"Segment Description Missing")_" >"
|
---|
| 8 | S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR) D TMP,BLANK^VAQDIS20
|
---|
| 9 | I $G(@XTRCT@("VALUE",2,.152,0))'="" D
|
---|
| 10 | .S X=$$SETSTR^VALM1("* Applicant is listed as (INELIGIBLE) for treatment","",1,79)
|
---|
| 11 | .D TMP
|
---|
| 12 | I $G(@XTRCT@("VALUE",2,.153,0))'="" D
|
---|
| 13 | .S X=$$SETSTR^VALM1("* Applicant is listed as (MISSING). NOTIFY APPROPRIATE PERSONNEL","",1,79)
|
---|
| 14 | .D TMP
|
---|
| 15 | D BLANK^VAQDIS20
|
---|
| 16 | S VAQLN=$$REPEAT^VAQUTL1(" ",79)
|
---|
| 17 | S VAQCTR=" -- PATIENT DEMOGRAPHICS -- "
|
---|
| 18 | S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR) D TMP,BLANK^VAQDIS20
|
---|
| 19 | K VAQLN,VAQCTR
|
---|
| 20 | ROW1 ;
|
---|
| 21 | S X=$$SETSTR^VALM1("Name: "_$G(@XTRCT@("VALUE",2,.01,0)),"",8,44)
|
---|
| 22 | S SSN=$$DASHSSN^VAQUTL99($G(@XTRCT@("VALUE",2,.09,0)))
|
---|
| 23 | S X=$$SETSTR^VALM1("SSN: "_SSN,X,45,16)
|
---|
| 24 | S X=$$SETSTR^VALM1("DOB: "_$G(@XTRCT@("VALUE",2,.03,0)),X,62,17)
|
---|
| 25 | D TMP K SSN
|
---|
| 26 | ROW2 ;
|
---|
| 27 | S SEQ=""
|
---|
| 28 | F J=1:1 S SEQ=$O(@XTRCT@("VALUE",2.01,.01,SEQ)) Q:SEQ="" D
|
---|
| 29 | .S:J=1 X=$$SETSTR^VALM1("Alias: "_$G(@XTRCT@("VALUE",2.01,.01,SEQ)),"",7,49)
|
---|
| 30 | .S:J'=1 X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",2.01,.01,SEQ)),"",14,49)
|
---|
| 31 | .S VAQASSN=$G(@XTRCT@("VALUE",2.01,1,SEQ))
|
---|
| 32 | .S:VAQASSN'="" VAQASSN=$$DASHSSN^VAQUTL99(VAQASSN)
|
---|
| 33 | .S X=$$SETSTR^VALM1(VAQASSN,X,50,29)
|
---|
| 34 | .D TMP
|
---|
| 35 | K J,SEQ,VAQASSN
|
---|
| 36 | ROW3 ;
|
---|
| 37 | S VAQTMP=$G(@XTRCT@("VALUE",2,.091,0))
|
---|
| 38 | S VAQINF=$S(VAQTMP="":"No remarks entered for this patient",1:VAQTMP)
|
---|
| 39 | S X=$$SETSTR^VALM1("Remark: "_VAQINF,"",5,79)
|
---|
| 40 | D TMP
|
---|
| 41 | K VAQTMP,VAQINF
|
---|
| 42 | ROW4 ;
|
---|
| 43 | S X=$$SETSTR^VALM1("Permanent Address:","",5,44)
|
---|
| 44 | S X=$$SETSTR^VALM1("Temporary Address:",X,45,34)
|
---|
| 45 | D TMP
|
---|
| 46 | ;
|
---|
| 47 | PRMADD ; -- Permanent Address
|
---|
| 48 | K ADDR
|
---|
| 49 | S VAQTMP=1
|
---|
| 50 | F VAQX=.111,.112,.113 D Q:(VAQINF="")
|
---|
| 51 | .S VAQINF=$G(@XTRCT@("VALUE",2,VAQX,0))
|
---|
| 52 | .I ((VAQX=.111)&(VAQINF="")) S VAQINF="STREET ADDRESS UNKNOWN"
|
---|
| 53 | .Q:(VAQINF="")
|
---|
| 54 | .S ADDR(VAQTMP)=VAQINF
|
---|
| 55 | .S VAQTMP=VAQTMP+1
|
---|
| 56 | S CTY=$G(@XTRCT@("VALUE",2,.114,0))
|
---|
| 57 | S ZIP=$G(@XTRCT@("VALUE",2,.1112,0))
|
---|
| 58 | S STATE=$$STATE^VAQDIS20($G(@XTRCT@("VALUE",2,.115,0)))
|
---|
| 59 | S VAQINF=$S((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$S(STATE="":" ",1:", ")_STATE_" "_ZIP)
|
---|
| 60 | S ADDR(VAQTMP)=VAQINF
|
---|
| 61 | TMPADD ;Temporary address
|
---|
| 62 | K ADDRT
|
---|
| 63 | S VAQTMP=1
|
---|
| 64 | F VAQX=.1211,.1212,.1213 D Q:(VAQINF="")
|
---|
| 65 | .S VAQINF=$G(@XTRCT@("VALUE",2,VAQX,0))
|
---|
| 66 | .I ((VAQX=.1211)&(VAQINF="")) S VAQINF="STREET ADDRESS UNKNOWN"
|
---|
| 67 | .Q:(VAQINF="")
|
---|
| 68 | .S ADDRT(VAQTMP)=VAQINF
|
---|
| 69 | .S VAQTMP=VAQTMP+1
|
---|
| 70 | S CTY=$G(@XTRCT@("VALUE",2,.1214,0))
|
---|
| 71 | S ZIP=$G(@XTRCT@("VALUE",2,.12112,0))
|
---|
| 72 | S STATE=$$STATE^VAQDIS20($G(@XTRCT@("VALUE",2,.1215,0)))
|
---|
| 73 | S VAQINF=$S((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$S(STATE="":" ",1:", ")_STATE_" "_ZIP)
|
---|
| 74 | S ADDRT(VAQTMP)=VAQINF
|
---|
| 75 | D ADRLOAD
|
---|
| 76 | K ADDR,ADDRT,VAQTMP,VAQINF,VAQX,CTY,STATE,ZIP
|
---|
| 77 | ;
|
---|
| 78 | ROW9 ; -- County
|
---|
| 79 | S CTYNUM=$G(@XTRCT@("VALUE",2,.117,0))
|
---|
| 80 | S COUNTY=$$COUNTY^VAQDIS20($G(@XTRCT@("VALUE",2,.115,0)),CTYNUM)
|
---|
| 81 | S VAQINF=COUNTY_" ("_CTYNUM_")"
|
---|
| 82 | S:(COUNTY="") VAQINF="UNKNOWN ("_CTYNUM_")"
|
---|
| 83 | S:((COUNTY="")&(CTYNUM="")) VAQINF="UNANSWERED"
|
---|
| 84 | S X=$$SETSTR^VALM1("County: "_VAQINF,"",2,43)
|
---|
| 85 | S CTYNUM=$G(@XTRCT@("VALUE",2,.12111,0))
|
---|
| 86 | S COUNTY=$$COUNTY^VAQDIS20($G(@XTRCT@("VALUE",2,.1215,0)),CTYNUM)
|
---|
| 87 | S VAQINF=COUNTY_" ("_CTYNUM_")"
|
---|
| 88 | S:(COUNTY="") VAQINF="UNKNOWN ("_CTYNUM_")"
|
---|
| 89 | S:((COUNTY="")&(CTYNUM="")) VAQINF="UNANSWERED"
|
---|
| 90 | S X=$$SETSTR^VALM1("County: "_VAQINF,X,44,35)
|
---|
| 91 | D TMP
|
---|
| 92 | K CTYNUM,COUNTY,VAQINF
|
---|
| 93 | ROW10 ; -- Phone
|
---|
| 94 | S X=$$SETSTR^VALM1("Phone: "_$G(@XTRCT@("VALUE",2,.131,0)),"",3,43)
|
---|
| 95 | S TPHONE=$G(@XTRCT@("VALUE",2,.1219,0))
|
---|
| 96 | S X=$$SETSTR^VALM1("Phone: "_$S(TPHONE'="":TPHONE,1:"NOT APPLICABLE"),X,45,34)
|
---|
| 97 | D TMP K TPHONE
|
---|
| 98 | ROW11 ; -- Work phone/temporary form-to
|
---|
| 99 | S X=$$SETSTR^VALM1("Office: "_$G(@XTRCT@("VALUE",2,.132,0)),"",2,43)
|
---|
| 100 | S VAQFROM=$G(@XTRCT@("VALUE",2,.1217,0))
|
---|
| 101 | S VAQTO=$G(@XTRCT@("VALUE",2,.1218,0))
|
---|
| 102 | S VAQFROMT=VAQFROM_"-"_VAQTO
|
---|
| 103 | I VAQFROMT="-" S VAQFROMT="NOT APPLICABLE"
|
---|
| 104 | S X=$$SETSTR^VALM1("From/To: "_VAQFROMT,X,43,36)
|
---|
| 105 | K VAQFROM,VAQTO,VAQFROMT
|
---|
| 106 | D TMP
|
---|
| 107 | EXIT ;
|
---|
| 108 | QUIT
|
---|
| 109 | ;
|
---|
| 110 | ADRLOAD ; -- Loads addresses into display array
|
---|
| 111 | F VAQX=1:1:4 D
|
---|
| 112 | .S VAQINF=""
|
---|
| 113 | .S:($D(ADDR(VAQX))) VAQINF=$$SETSTR^VALM1(ADDR(VAQX),VAQINF,15,53)
|
---|
| 114 | .S:($D(ADDRT(VAQX))) VAQINF=$$SETSTR^VALM1(ADDRT(VAQX),VAQINF,54,25)
|
---|
| 115 | .Q:(VAQINF="")
|
---|
| 116 | .S VALMCNT=VALMCNT+1
|
---|
| 117 | .S @ROOT@(VALMCNT,0)=$E(VAQINF,1,79)
|
---|
| 118 | Q
|
---|
| 119 | ;
|
---|
| 120 | TMP ; -- Sets up display array
|
---|
| 121 | S VALMCNT=VALMCNT+1
|
---|
| 122 | S @ROOT@(VALMCNT,0)=$E(X,1,79)
|
---|
| 123 | QUIT
|
---|
| 124 | ;
|
---|
| 125 | END ; -- End of code
|
---|
| 126 | QUIT
|
---|