51 lines
3.1 KiB
Mathematica
51 lines
3.1 KiB
Mathematica
|
SRODLA1 ;B'HAM ISC/MAM - DELAYS, ONE SPECIALTY ; [ 04/04/00 11:23 AM ]
|
||
|
|
;;3.0; Surgery ;**75,94**;24 Jun 93
|
||
|
|
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
|
||
|
|
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
|
||
|
|
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
|
||
|
|
S CAUSE=0 F S CAUSE=$O(^TMP("SRF",$J,CAUSE)) Q:CAUSE=""!(SRSOUT) D CAUSE Q:SRSOUT S SRSDATE=0 D MORE
|
||
|
|
I ^TMP("SR",$J)=0 W !!,"No data for selected date range."
|
||
|
|
Q
|
||
|
|
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
|
||
|
|
Q
|
||
|
|
PRINT ; print case information
|
||
|
|
I $Y+5>IOSL D PAGE^SRODLAY Q:SRSOUT D CAUSE
|
||
|
|
S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRNM=VADM(1)
|
||
|
|
S SRATT=$P($G(^SRF(SRTN,.1)),"^",13) S:SRATT SRATT=$P(^VA(200,SRATT,0),"^") S SRDEL=$P(SRD,"^"),SRDC=$P(SRD,"^",2)
|
||
|
|
OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
|
||
|
|
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=""
|
||
|
|
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
|
||
|
|
W !!,$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3),?12,SRNM,?44,SRATT W:$D(SRCOM(1)) ?84,SRCOM(1)
|
||
|
|
W !,SRDEL_" MINS.",?14,VA("PID"),?44,SROP(1) I $D(SRCOM(2)) W ?84,SRCOM(2)
|
||
|
|
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)
|
||
|
|
Q
|
||
|
|
UTIL Q:'$P($G(^SRF(SRTN,.2)),"^",12) Q:'$O(^SRF(SRTN,17,0))
|
||
|
|
S SRSS1=$P(^SRF(SRTN,0),"^",4) I SRSS'=SRSS1 Q
|
||
|
|
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
|
||
|
|
Q
|
||
|
|
SETUT I '$D(^TMP("SR",$J,CAUSE)) S ^TMP("SR",$J,CAUSE)=0
|
||
|
|
S ^TMP("SR",$J)=^TMP("SR",$J)+1,^TMP("SR",$J,CAUSE)=^TMP("SR",$J,CAUSE)+1
|
||
|
|
S ^TMP("SRF",$J,CAUSE,SRSDATE,SRTN)=SRDEL_"^"_SRDC
|
||
|
|
Q
|
||
|
|
CAUSE I $Y+12>IOSL D PAGE^SRODLAY Q:SRSOUT
|
||
|
|
S SRCAUS=$P(^SRO(132.4,CAUSE,0),"^"),SRCOL=132-$L(SRCAUS)\2,SRUL="" F LINE=1:1:$L(SRCAUS) S SRUL=SRUL_"-"
|
||
|
|
W !!,?SRCOL,SRCAUS,!,?SRCOL,SRUL
|
||
|
|
Q
|
||
|
|
OTHER ; other operations
|
||
|
|
S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>250 S SRLONG=0,OPER=999,SROPERS=" ..."
|
||
|
|
I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")
|
||
|
|
S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
|
||
|
|
Q
|
||
|
|
LOOP ; break procedure if greater than 38 characters
|
||
|
|
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
|
||
|
|
Q
|
||
|
|
COM S SRX=^SRF(SRTN,17,SRDC,1,SRL,0) I $L(SRX)<48 S SRCOM(SRCNT)=SRX,SRCNT=SRCNT+1 Q
|
||
|
|
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
|
||
|
|
.S SRQ=0 I $L(MM)'<48 D S SRX=SRZ Q
|
||
|
|
..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))
|
||
|
|
..S M=M+K-1
|
||
|
|
.I $L(SRX(M))+$L(MM)'<48 S SRQ=1 Q
|
||
|
|
.S SRX(M)=SRX(M)_MM_" ",SRX=SRZ
|
||
|
|
F I=1:1:M-1 S SRCOM(SRCNT)=SRX(I) S SRCNT=SRCNT+1
|
||
|
|
Q
|