| 1 | SROCAN0 ;B'HAM ISC/MAM - REPORT OF CANCELLATIONS (CONT.); [ 04/06/00 9:54 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**14,94**;24 Jun 93
|
|---|
| 3 | U IO K ^TMP("SR",$J),SRSPEC S SRD=SRSD-.0001,SRE=SRED+.9999,(SRHDR,SRQ)=0,PAGE=1
|
|---|
| 4 | S Y=DT D D^DIQ S SRPRINT=$E(Y,1,12)
|
|---|
| 5 | F S SRD=$O(^SRF("AC",SRD)) Q:SRQ!(SRD>SRE)!('SRD) S SRTN=0 F S SRTN=$O(^SRF("AC",SRD,SRTN)) Q:SRQ!('SRTN) I $D(^SRF(SRTN,0)),$P($G(^SRF(SRTN,30)),"^")'="",$$MANDIV^SROUTL0(SRINSTP,SRTN) D SET
|
|---|
| 6 | D HDR S SRSS="" F S SRSS=$O(^TMP("SR",$J,SRSS)) Q:SRSS=""!(SRQ) D SRSP S SRTN=0 F S SRTN=$O(^TMP("SR",$J,SRSS,SRTN)) Q:'SRTN!(SRQ) D CASE
|
|---|
| 7 | I SRSP S SRSS="" F S SRSS=$O(SRSP(SRSS)) Q:'SRSS!SRQ I '$D(^TMP("SR",$J,SRSS)) D SRSP D:$Y+4>IOSL HDR Q:SRQ W !,"No data for selected date range."
|
|---|
| 8 | I 'SRSP,'$D(^TMP("SR",$J)) W !!,"No data for selected date range."
|
|---|
| 9 | D END
|
|---|
| 10 | Q
|
|---|
| 11 | SRSP S SRSPEC=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"NO SPECIALTY ENTERED"),SRSPEC=">> SURGICAL SPECIALTY: "_SRSPEC_" <<" D SUB
|
|---|
| 12 | Q
|
|---|
| 13 | SET ; set up ^TMP
|
|---|
| 14 | Q:$P($G(^SRF(SRTN,"NON")),"^")="Y" S SRSS=$P(^SRF(SRTN,0),"^",4) S:SRSS="" SRSS="ZZ" I SRSP,'$D(SRSP(SRSS)) Q
|
|---|
| 15 | S ^TMP("SR",$J,SRSS,SRTN)=""
|
|---|
| 16 | Q
|
|---|
| 17 | CASE ; print individual case
|
|---|
| 18 | I $Y+6>IOSL D HDR Q:SRQ
|
|---|
| 19 | S S(0)=^SRF(SRTN,0),DFN=$P(S(0),"^") D DEM^VADPT S SRNM=VADM(1),SRSSN=VA("PID"),Y=$P(S(0),"^",9) D D^DIQ S SROD=$E(Y,1,12)
|
|---|
| 20 | S SRCR=$P($G(^SRF(SRTN,31)),"^",8) S:SRCR'="" SRCR=$P(^SRO(135,SRCR,0),"^")
|
|---|
| 21 | S Y=$P(^SRF(SRTN,30),"^") D:Y D^DIQ S SRCD=$P(Y,"@")_" "_$E($P(Y,"@",2),1,5)
|
|---|
| 22 | K ABORT S ABORT=$P($G(^SRF(SRTN,.2)),"^",10)
|
|---|
| 23 | OPS S SROPER=$S(ABORT:"* ",1:"")_$P(^SRF(SRTN,"OP"),"^"),OPER=0 F S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
|
|---|
| 24 | K SROPS,MM,MMM S:$L(SROPER)<50 SROPS(1)=SROPER I $L(SROPER)>49 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
|
|---|
| 25 | PRINT ;
|
|---|
| 26 | W !!,SROD,?15,$E(SRNM,1,28),?44,SROPS(1),?95,SRCD,!,SRTN,?15,VA("PID") W:$D(SROPS(2)) ?44,SROPS(2) W ?95,SRCR
|
|---|
| 27 | I $D(SROPS(3)) W !,?44,SROPS(3) I $D(SROPS(4)) W !,?44,SROPS(4) I $D(SROPS(5)) W !,?44,SROPS(5) I $D(SROPS(6)) W !,?44,SROPS(6)
|
|---|
| 28 | Q
|
|---|
| 29 | END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q
|
|---|
| 30 | I 'SRQ,$E(IOST)'="P" W !!,"Press RETURN to continue " R X:DTIME
|
|---|
| 31 | D ^SRSKILL K SRTN D ^%ZISC W @IOF
|
|---|
| 32 | Q
|
|---|
| 33 | OTHER ; other operations
|
|---|
| 34 | S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>250 S SRLONG=0,OPER=999,SROPERS=" ..."
|
|---|
| 35 | I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")
|
|---|
| 36 | S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
|
|---|
| 37 | Q
|
|---|
| 38 | LOOP ; break procedure if greater than 55 characters
|
|---|
| 39 | S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<50 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
|
|---|
| 40 | Q
|
|---|
| 41 | HDR ; print heading
|
|---|
| 42 | I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRQ=1 Q
|
|---|
| 43 | I SRHDR,$E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRQ=1 Q
|
|---|
| 44 | W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,?115,"PAGE: "_PAGE,!,?55,"REPORT OF CANCELLATIONS",?100,"REVIEWED BY:"
|
|---|
| 45 | W !,"PRINTED: ",SRPRINT,?53,"FROM ",$E(SRSD,4,5),"/",$E(SRSD,6,7),"/",$E(SRSD,2,3)," TO ",$E(SRED,4,5),"/",$E(SRED,6,7),"/",$E(SRED,2,3),?100,"DATE REVIEWED:"
|
|---|
| 46 | W !!,"DATE",?15,"PATIENT",?44,"OPERATION(S)",?95,"CANCEL DATE",!,"CASE #",?15,"ID#",?95,"REASON",! F I=1:1:IOM W "="
|
|---|
| 47 | S (SRHDR,SRPAGE)=1,PAGE=PAGE+1 D:$D(SRSPEC) SUB1
|
|---|
| 48 | Q
|
|---|
| 49 | SUB ; print specialty sub-heading
|
|---|
| 50 | I $Y+8>IOSL D HDR I SRQ!('SRPAGE) Q
|
|---|
| 51 | I 'SRPAGE W !! F LINE=1:1:132 W "-"
|
|---|
| 52 | SUB1 W !,?(132-$L(SRSPEC)\2),SRSPEC S SRPAGE=0
|
|---|
| 53 | Q
|
|---|
