| 1 | SROTRPT ;B'HAM ISC/MAM - TISSUE EXAM REPORT ; 16 JULY 1990 10:00
|
|---|
| 2 | ;;3.0; Surgery ;**31,111,145**;24 Jun 93
|
|---|
| 3 | S SRSOUT=0
|
|---|
| 4 | I '$D(SRSITE) D ^SROVAR S SRSITE("KILL")=1
|
|---|
| 5 | I '$D(SRTN) K SRNEWOP D ^SROPS I '$D(SRTN) S SRSOUT=1 G END
|
|---|
| 6 | K %ZIS,IOP,POP,IO("Q") S %ZIS="Q" D ^%ZIS I POP S SRSOUT=1 G END
|
|---|
| 7 | I $D(IO("Q")) K IO("Q") S ZTDESC="TISSUE EXAM REPORT",ZTRTN="RPT^SROTRPT",(ZTSAVE("SRSITE*"),ZTSAVE("SRTN"))="",ZTSAVE("SRT")="UL" D ^%ZTLOAD S SRSOUT=1 G END
|
|---|
| 8 | RPT ; entry when queued
|
|---|
| 9 | S SRSOUT=0 I '$D(ZTQUEUED) S SRT=$S($E(IOST)="P":"UL",1:"Q")
|
|---|
| 10 | D ^SROTRPT0,FOOT
|
|---|
| 11 | END I $E(IOST)'="P",'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
|
|---|
| 12 | W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
|
|---|
| 13 | D ^%ZISC W @IOF D ^SRSKILL
|
|---|
| 14 | Q
|
|---|
| 15 | FOOT ; print footer
|
|---|
| 16 | ;
|
|---|
| 17 | ;Find ethnicity entry
|
|---|
| 18 | S SROETH=""
|
|---|
| 19 | I $G(VADM(11,1)) S SROETH=$P(VADM(11,1),U,2)
|
|---|
| 20 | I '$G(VADM(11,1)) S SROETH="UNANSWERED"
|
|---|
| 21 | ;
|
|---|
| 22 | ;Find all race entries and place into a string with commas inbetween
|
|---|
| 23 | S SRORC=0,C=1,SRORACE="",SROLINE="",N=1,SROL=""
|
|---|
| 24 | F S SRORC=$O(VADM(12,SRORC)) Q:SRORC="" Q:C=11 D
|
|---|
| 25 | .I $G(VADM(12,SRORC)) S SRORACE(C)=$P(VADM(12,SRORC),U,2)
|
|---|
| 26 | .I SROLINE'="" S SROLINE=SROLINE_", "_SRORACE(C)
|
|---|
| 27 | .I SROLINE="" S SROLINE=SRORACE(C)
|
|---|
| 28 | .S C=C+1
|
|---|
| 29 | ;
|
|---|
| 30 | ;Find total length of 'race' string and wrap the text if necessary
|
|---|
| 31 | I $L(SROLINE)=72!$L(SROLINE)<72 S SROL(N)=SROLINE,SRNUM1=2
|
|---|
| 32 | I $L(SROLINE)>72 D WRAP
|
|---|
| 33 | ;
|
|---|
| 34 | Q:SRSOUT F X=1:1 Q:$Y>(IOSL-13) W !
|
|---|
| 35 | W !,?30,"(Continue on reverse side)",! F SRLINE=1:1:80 W "-"
|
|---|
| 36 | W !,"PATHOLOGIST'S SIGNATURE",?58,"DATE: ",! F SRLINE=1:1:80 W "-"
|
|---|
| 37 | W !,VADM(1),?30,"AGE: "_VADM(4),?40,"SEX: "_$P(VADM(5),"^",2),?58,"ID # "_VA("PID"),!,"ETHNICITY: "_SROETH
|
|---|
| 38 | W ?58,"REGISTER NO. "
|
|---|
| 39 | W !,"RACE: "
|
|---|
| 40 | I $G(VADM(12)) F D=1:1:SRNUM1-1 D
|
|---|
| 41 | .W:D=1 ?7,SROL(D)
|
|---|
| 42 | .W:D'=1 !,?7,SROL(D)
|
|---|
| 43 | I '$G(VADM(12)) W ?7,"UNANSWERED"
|
|---|
| 44 | ;
|
|---|
| 45 | K SROL,SROLINE,SRORC,SRORACE,SROLN,SROLN1,SROWRAP,SRNUM1
|
|---|
| 46 | ;
|
|---|
| 47 | W !,"WARD: "_SRWARD,?30,"ROOM-BED: "_SROOM
|
|---|
| 48 | W ! F SRLINE=1:1:80 W "-"
|
|---|
| 49 | W !,SRINST,?58,"REPLACEMENT FORM 515"
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | WRAP ;Wrap multiple race entries so that wrapped line
|
|---|
| 53 | ;does not break in the middle of a word
|
|---|
| 54 | ;
|
|---|
| 55 | S SROLNGTH=$L(SROLINE),E=72,SROWRAP="",SROLN="",SROLN1="",SROL=""
|
|---|
| 56 | F I=1:72:SROLNGTH+1 S SROLN(I)=SROWRAP_$E(SROLINE,I,E) D
|
|---|
| 57 | .F K=72:-1:1 I $E(SROLN(I),K)[" " D Q ;Break lines at space
|
|---|
| 58 | ..S SROLN1(I)=$E(SROLN(I),1,K-1)
|
|---|
| 59 | ..S SROWRAP=$E(SROLN(I),K+1,E)
|
|---|
| 60 | .S E=E+72
|
|---|
| 61 | ;I $L(SROLN1(I))+$L(SROWRAP)>71 S SROLN1(I+1)=SROWRAP ;Last line
|
|---|
| 62 | ;I $L(SROLN1(I))+$L(SROWRAP)'>71 S SROLN1(I)=SROLN1(I)_" "_SROWRAP
|
|---|
| 63 | I $L(SROLN(I))+$L(SROWRAP)>71 S SROLN1(I+1)=SROWRAP ;Last line
|
|---|
| 64 | I $L(SROLN(I))+$L(SROWRAP)'>71 S SROLN1(I)=SROLN(I)
|
|---|
| 65 | ;
|
|---|
| 66 | ;Renumber the SROLN1 array to be in numeric order
|
|---|
| 67 | S SRNUM=0,SRNUM1=1
|
|---|
| 68 | F S SRNUM=$O(SROLN1(SRNUM)) Q:SRNUM="" D
|
|---|
| 69 | .S SROL(SRNUM1)=SROLN1(SRNUM)
|
|---|
| 70 | .S SRNUM1=SRNUM1+1
|
|---|
| 71 | Q
|
|---|
