| [613] | 1 | SRODLA1 ;B'HAM ISC/MAM - DELAYS, ONE SPECIALTY ; [ 04/04/00 11:23 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**75,94**;24 Jun 93
|
|---|
| 3 | S SPEC=$P(^SRO(137.45,SRSS,0),"^"),(PAGE,SRSOUT,SRHDR)=0 K ^TMP("SR",$J),^TMP("SRT",$J),^TMP("SRF",$J) S ^TMP("SR",$J)=0
|
|---|
| 4 | S SRSDATE=SRSD-.0001,SREDT=SRED+.9999,SRPRINT=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3) D HDR^SRODLAY Q:SRSOUT
|
|---|
| 5 | F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:'SRSDATE!(SRSDATE>SREDT) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTIL
|
|---|
| 6 | S CAUSE=0 F S CAUSE=$O(^TMP("SRF",$J,CAUSE)) Q:CAUSE=""!(SRSOUT) D CAUSE Q:SRSOUT S SRSDATE=0 D MORE
|
|---|
| 7 | I ^TMP("SR",$J)=0 W !!,"No data for selected date range."
|
|---|
| 8 | Q
|
|---|
| 9 | MORE F S SRSDATE=$O(^TMP("SRF",$J,CAUSE,SRSDATE)) Q:'SRSDATE!(SRSOUT) S SRTN=0 F S SRTN=$O(^TMP("SRF",$J,CAUSE,SRSDATE,SRTN)) W:'SRTN ! Q:'SRTN!(SRSOUT) S SRD=^(SRTN) D PRINT
|
|---|
| 10 | Q
|
|---|
| 11 | PRINT ; print case information
|
|---|
| 12 | I $Y+5>IOSL D PAGE^SRODLAY Q:SRSOUT D CAUSE
|
|---|
| 13 | S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRNM=VADM(1)
|
|---|
| 14 | S SRATT=$P($G(^SRF(SRTN,.1)),"^",13) S:SRATT SRATT=$P(^VA(200,SRATT,0),"^") S SRDEL=$P(SRD,"^"),SRDC=$P(SRD,"^",2)
|
|---|
| 15 | OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
|
|---|
| 16 | K SROP,MM,MMM S:$L(SROPER)<39 SROP(1)=SROPER I $L(SROPER)>38 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
|
|---|
| 17 | K SRX,SRCOM I $O(^SRF(SRTN,17,SRDC,1,0)) S SRL=0,SRCNT=1 F S SRL=$O(^SRF(SRTN,17,SRDC,1,SRL)) Q:'SRL D COM
|
|---|
| 18 | W !!,$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3),?12,SRNM,?44,SRATT W:$D(SRCOM(1)) ?84,SRCOM(1)
|
|---|
| 19 | W !,SRDEL_" MINS.",?14,VA("PID"),?44,SROP(1) I $D(SRCOM(2)) W ?84,SRCOM(2)
|
|---|
| 20 | F J=2:1 Q:'$D(SROP(J))&('$D(SRCOM(J+1))) W ! W:$D(SROP(J)) ?44,SROP(J) W:$D(SRCOM(J+1)) ?84,SRCOM(J+1)
|
|---|
| 21 | Q
|
|---|
| 22 | UTIL Q:'$P($G(^SRF(SRTN,.2)),"^",12) Q:'$O(^SRF(SRTN,17,0))
|
|---|
| 23 | S SRSS1=$P(^SRF(SRTN,0),"^",4) I SRSS'=SRSS1 Q
|
|---|
| 24 | S SRDC=0 F S SRDC=$O(^SRF(SRTN,17,SRDC)) Q:'SRDC S CAUSE=$P(^SRF(SRTN,17,SRDC,0),"^"),SRDEL=$P(^(0),"^",2) D SETUT
|
|---|
| 25 | Q
|
|---|
| 26 | SETUT I '$D(^TMP("SR",$J,CAUSE)) S ^TMP("SR",$J,CAUSE)=0
|
|---|
| 27 | S ^TMP("SR",$J)=^TMP("SR",$J)+1,^TMP("SR",$J,CAUSE)=^TMP("SR",$J,CAUSE)+1
|
|---|
| 28 | S ^TMP("SRF",$J,CAUSE,SRSDATE,SRTN)=SRDEL_"^"_SRDC
|
|---|
| 29 | Q
|
|---|
| 30 | CAUSE I $Y+12>IOSL D PAGE^SRODLAY Q:SRSOUT
|
|---|
| 31 | S SRCAUS=$P(^SRO(132.4,CAUSE,0),"^"),SRCOL=132-$L(SRCAUS)\2,SRUL="" F LINE=1:1:$L(SRCAUS) S SRUL=SRUL_"-"
|
|---|
| 32 | W !!,?SRCOL,SRCAUS,!,?SRCOL,SRUL
|
|---|
| 33 | Q
|
|---|
| 34 | OTHER ; other operations
|
|---|
| 35 | S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>250 S SRLONG=0,OPER=999,SROPERS=" ..."
|
|---|
| 36 | I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")
|
|---|
| 37 | S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
|
|---|
| 38 | Q
|
|---|
| 39 | LOOP ; break procedure if greater than 38 characters
|
|---|
| 40 | S SROP(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROP(M))+$L(MM)'<38 S SROP(M)=SROP(M)_MM_" ",SROPER=MMM
|
|---|
| 41 | Q
|
|---|
| 42 | COM S SRX=^SRF(SRTN,17,SRDC,1,SRL,0) I $L(SRX)<48 S SRCOM(SRCNT)=SRX,SRCNT=SRCNT+1 Q
|
|---|
| 43 | S SRX=SRX_" " F M=1:1 Q:SRX=" " S SRX(M)="" F L=1:1 S MM=$P(SRX," "),SRZ=$P(SRX," ",2,250) Q:SRZ="" D Q:SRQ
|
|---|
| 44 | .S SRQ=0 I $L(MM)'<48 D S SRX=SRZ Q
|
|---|
| 45 | ..S SRQ=1 F K=0:1 Q:MM="" S MMM=$E(MM,1,47),SRX(M+K)=MMM,MM=$E(MM,48,$L(MM))
|
|---|
| 46 | ..S M=M+K-1
|
|---|
| 47 | .I $L(SRX(M))+$L(MM)'<48 S SRQ=1 Q
|
|---|
| 48 | .S SRX(M)=SRX(M)_MM_" ",SRX=SRZ
|
|---|
| 49 | F I=1:1:M-1 S SRCOM(SRCNT)=SRX(I) S SRCNT=SRCNT+1
|
|---|
| 50 | Q
|
|---|
