| 1 | SRORACE ;B'HAM ISC/ADM - PATIENT DEMOGRAPHIC INFO ; [ 04/05/04 9:47 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**125**;24 Jun 93
|
|---|
| 3 | ENTH D DEM^VADPT
|
|---|
| 4 | ;Find patient's ethnicity and list it on the display
|
|---|
| 5 | W !," Ethnicity:" D
|
|---|
| 6 | .I $G(VADM(11)) W ?40,$P(VADM(11,1),U,2)
|
|---|
| 7 | .I '$G(VADM(11)) W ?40,"UNANSWERED"
|
|---|
| 8 | ;
|
|---|
| 9 | ;Find all race entries and place into a string with commas inbetween
|
|---|
| 10 | S SRORC=0,C=1,SRORACE="",SROLINE="",N=1,SROL=""
|
|---|
| 11 | F S SRORC=$O(VADM(12,SRORC)) Q:SRORC="" Q:C=11 D
|
|---|
| 12 | .I $G(VADM(12,SRORC)) S SRORACE(C)=$P(VADM(12,SRORC),U,2)
|
|---|
| 13 | .I SROLINE'="" S SROLINE=SROLINE_", "_SRORACE(C)
|
|---|
| 14 | .I SROLINE="" S SROLINE=SRORACE(C)
|
|---|
| 15 | .S C=C+1
|
|---|
| 16 | ;
|
|---|
| 17 | ;Find total length of 'race' string and wrap the text if necessary
|
|---|
| 18 | I $L(SROLINE)=40!$L(SROLINE)<40 S SROL(N)=SROLINE,SRNUM1=2
|
|---|
| 19 | I $L(SROLINE)>40 D WRAP
|
|---|
| 20 | ;
|
|---|
| 21 | W !," Race Category(ies):"
|
|---|
| 22 | I $G(VADM(12)) F D=1:1:SRNUM1-1 D
|
|---|
| 23 | .W:D=1 ?40,SROL(D)
|
|---|
| 24 | .W:D'=1 !,?40,SROL(D)
|
|---|
| 25 | ;
|
|---|
| 26 | I '$G(VADM(12)) W ?40,"UNANSWERED"
|
|---|
| 27 | ;
|
|---|
| 28 | K SROL,SROLINE,SRORC,SRORACE,SROLN,SROLN1,SROWRAP,SRNUM1
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | WRAP ;Wrap multiple race entries so that wrapped line
|
|---|
| 32 | ;does not break in the middle of a word
|
|---|
| 33 | ;
|
|---|
| 34 | S SROLNGTH=$L(SROLINE),E=40,SROWRAP="",SROLN="",SROLN1="",SROL=""
|
|---|
| 35 | F I=1:40:SROLNGTH S SROLN(I)=SROWRAP_$E(SROLINE,I,E) D
|
|---|
| 36 | .F K=40:-1:1 I $E(SROLN(I),K)[" " D Q ;Break lines at space
|
|---|
| 37 | ..S SROLN1(I)=$E(SROLN(I),1,K-1)
|
|---|
| 38 | ..S SROWRAP=$E(SROLN(I),K+1,E)
|
|---|
| 39 | .S E=E+40
|
|---|
| 40 | ;
|
|---|
| 41 | S:'$D(SROLN1(I)) SROLN1(I)=SROLN(I),SROWRAP=""
|
|---|
| 42 | I $L(SROLN1(I))+$L(SROWRAP)>39 S SROLN1(I+1)=SROWRAP ;Last line
|
|---|
| 43 | I $L(SROLN1(I))+$L(SROWRAP)'>39 S SROLN1(I)=SROLN1(I)_" "_SROWRAP
|
|---|
| 44 | ;
|
|---|
| 45 | ;Renumber the SROLN1 array to be in numeric order
|
|---|
| 46 | S SRNUM=0,SRNUM1=1
|
|---|
| 47 | F S SRNUM=$O(SROLN1(SRNUM)) Q:SRNUM="" D
|
|---|
| 48 | .S SROL(SRNUM1)=SROLN1(SRNUM)
|
|---|
| 49 | .S SRNUM1=SRNUM1+1
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | EXT I $L(SREXT)<40 W ?40,SREXT W:SRFLD=247 $S(SREXT="":"",SREXT=1:" Day",SREXT=0:" Days",SREXT>1:" Days",1:"") Q
|
|---|
| 53 | N I,J,X,Y S X=SREXT F D W:$L(X) ! I $L(X)<40!(X'[" ") W ?40,X Q
|
|---|
| 54 | .F I=0:1:38 S J=39-I,Y=$E(X,J) I Y=" " W ?40,$E(X,1,J-1) S X=$E(X,J+1,$L(X)) Q
|
|---|
| 55 | Q
|
|---|
