- SROADOC1 ;B'HAM ISC/MAM - ANESTHESIA PROV REPORT (CONT); [ 09/07/00 11:24 AM ]
- ;;3.0; Surgery ;**38,39,53,50,95,151,155**;24 Jun 93
- ;
- ; Reference to ^PSS50 supported by DBIA #4533
- ;
- SET ; set and print results
- S S(0)=^SRF(SRTN,0),S(.3)=^SRF(SRTN,.3)
- S DFN=$P(S(0),"^") D DEM^VADPT S SRDPT=VADM(1),SRSSN=VA("PID"),SRSDATE=$P(S(0),"^",9),SRREL=$P(S(.3),"^",2),SRSUP=$P(S(.3),"^",4),SRASS=$P(S(.3),"^",3),SRCODE=$P(S(.3),"^",6)
- S:SRCODE'="" SRCODE=$P(^SRO(132.95,SRCODE,0),"^",2)
- S SRANT="" I $D(^SRF(SRTN,.2)) S SRANE1=$P(^(.2),"^"),SRANE2=$P(^(.2),"^",4) I SRANE1,SRANE2 S X1=SRANE2,X=SRANE1 D MINS^SRSUTL2 S SRANT=X
- S:SRREL'="" SRREL=$P(^VA(200,SRREL,0),"^") S:$L(SRREL)>15 SRREL=$P(SRREL,",")_","_$E($P(SRREL,",",2)) S:SRSUP'="" SRSUP=$P(^VA(200,SRSUP,0),"^") S:$L(SRSUP)>15 SRSUP=$P(SRSUP,",")_","_$E($P(SRSUP,",",2))
- S:SRASS'="" SRASS=$P(^VA(200,SRASS,0),"^") I $L(SRASS)>15 S SRASS=$P(SRASS,",")_","_$E($P(SRASS,",",2))
- S SRSDT=$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)
- TECH D TECH^SROPRIN S SRAGNT="" I $D(SRZ) D AGENT
- ASA S Y=$P($G(^SRF(SRTN,1.1)),"^",3),C=$P(^DD(130,1.13,0),"^",2) D:Y'="" Y^DIQ S SRASA=$P(Y,"-",2,3)
- OPS K SROPERS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
- 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=""
- PRINT ; print results
- Q:SRF I $Y+10>IOSL D CODES^SROADOC,PAGE Q:SRF
- W !,$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3),?10,$P(SRDPT,",")_", "_$E($P(SRDPT,",",2)),?26,SROPS(1),?76,SRSUP,?93,SRASA,?124,SRCODE
- W !,SRTN,?10,VA("PID") W:$D(SROPS(2)) ?26,SROPS(2) W ?76,SRREL,?93,$E(SRTECH,1,20),?120,SRANT_$S(SRANT:" MINS.",1:"")
- W ! W:$P($G(^SRF(SRTN,"NON")),"^")="Y" "NON-O.R." W:$D(SROPS(3)) ?26,SROPS(3) W ?76,SRASS,?93,SRAGNT,!
- I $D(SROPS(4)) W ?26,SROPS(4),! W:$D(SROPS(5)) ?26,SROPS(5),! I $D(SROPS(6)) W ?26,SROPS(6),!
- Q
- HDR I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRF=1 Q
- W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,?120,"PAGE: "_PAGE,!,?58,"SURGICAL SERVICE",?100,"REVIEWED BY:",!,?53,"ANESTHESIA PROVIDER REPORT",?100,"DATE REVIEWED:"
- W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,"DATE PRINTED: "_SRPRINT
- W !!,"DATE",?10,"PATIENT",?26,"PROCEDURE(S)",?77,"SUPERVISOR",?96,"ASA CLASS",?111,"LEVEL OF SUPERVISION",!,"CASE #",?12,"ID#",?76,"RELIEF ANESTH",?92,"PRINCIPAL TECHNIQUE",?113,"ELAPSED ANES TIME",!,?76,"ASST ANESTH"
- W ?93,"ANESTHESIA AGENT",! F LINE=1:1:132 W "="
- S PAGE=PAGE+1 I $D(PRIN) W !!,?2,"***** "_PRIN_" *****",!
- Q
- PAGE I $E(IOST)'="P" W !!,"Press RETURN to continue, '^' to quit " R ASK:DTIME I '$T!(ASK="^") S SRF=1 Q
- D HDR Q
- END I $E(IOST)'="P",'SRF W !!,"Press RETURN to continue " R X:DTIME
- W:$E(IOST)="P" @IOF I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q
- D ^SRSKILL K SRTN D ^%ZISC W @IOF
- 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
- AGENT S SRAGNT=$O(^SRF(SRTN,6,SRT,1,0)) Q:SRAGNT="" S SRAGNT=$P(^SRF(SRTN,6,SRT,1,SRAGNT,0),"^") D
- .D DATA^PSS50(SRAGNT,,,,,"SRRX") S SRAGNT=$P($G(^TMP($J,"SRRX",SRAGNT,.01)),"^") K ^TMP($J,"SRRX",SRAGNT)
- Q
- PR S SRSOUT=0 D HDR G END:SRSOUT S PRIN=0
- F S PRIN=$O(^TMP("SR",$J,PRIN)) Q:PRIN=""!(SRF) W:$Y+10'>IOSL !!,?2,"***** "_PRIN_" *****",! S DATE=0 F S DATE=$O(^TMP("SR",$J,PRIN,DATE)) Q:'DATE!(SRF) S SRTN=0 F S SRTN=$O(^TMP("SR",$J,PRIN,DATE,SRTN)) Q:'SRTN!(SRF) D SET
- I '$D(^TMP("SR",$J)) W $$NODATA^SROUTL0()
- F I=$Y:1:(IOSL-8) W !
- I 'SRF D CODES^SROADOC
- G END
- LOOP ; break procedure name if greater than 50 characters
- 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
- Q
- SROADOC1 ;B'HAM ISC/MAM - ANESTHESIA PROV REPORT (CONT); [ 09/07/00 11:24 AM ]
- +1 ;;3.0; Surgery ;**38,39,53,50,95,151,155**;24 Jun 93
- +2 ;
- +3 ; Reference to ^PSS50 supported by DBIA #4533
- +4 ;
- SET ; set and print results
- +1 SET S(0)=^SRF(SRTN,0)
- SET S(.3)=^SRF(SRTN,.3)
- +2 SET DFN=$PIECE(S(0),"^")
- DO DEM^VADPT
- SET SRDPT=VADM(1)
- SET SRSSN=VA("PID")
- SET SRSDATE=$PIECE(S(0),"^",9)
- SET SRREL=$PIECE(S(.3),"^",2)
- SET SRSUP=$PIECE(S(.3),"^",4)
- SET SRASS=$PIECE(S(.3),"^",3)
- SET SRCODE=$PIECE(S(.3),"^",6)
- +3 IF SRCODE'=""
- SET SRCODE=$PIECE(^SRO(132.95,SRCODE,0),"^",2)
- +4 SET SRANT=""
- IF $DATA(^SRF(SRTN,.2))
- SET SRANE1=$PIECE(^(.2),"^")
- SET SRANE2=$PIECE(^(.2),"^",4)
- IF SRANE1
- IF SRANE2
- SET X1=SRANE2
- SET X=SRANE1
- DO MINS^SRSUTL2
- SET SRANT=X
- +5 IF SRREL'=""
- SET SRREL=$PIECE(^VA(200,SRREL,0),"^")
- IF $LENGTH(SRREL)>15
- SET SRREL=$PIECE(SRREL,",")_","_$EXTRACT($PIECE(SRREL,",",2))
- IF SRSUP'=""
- SET SRSUP=$PIECE(^VA(200,SRSUP,0),"^")
- IF $LENGTH(SRSUP)>15
- SET SRSUP=$PIECE(SRSUP,",")_","_$EXTRACT($PIECE(SRSUP,",",2))
- +6 IF SRASS'=""
- SET SRASS=$PIECE(^VA(200,SRASS,0),"^")
- IF $LENGTH(SRASS)>15
- SET SRASS=$PIECE(SRASS,",")_","_$EXTRACT($PIECE(SRASS,",",2))
- +7 SET SRSDT=$EXTRACT(SRSDATE,4,5)_"/"_$EXTRACT(SRSDATE,6,7)
- TECH DO TECH^SROPRIN
- SET SRAGNT=""
- IF $DATA(SRZ)
- DO AGENT
- ASA SET Y=$PIECE($GET(^SRF(SRTN,1.1)),"^",3)
- SET C=$PIECE(^DD(130,1.13,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- SET SRASA=$PIECE(Y,"-",2,3)
- OPS KILL SROPERS
- SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
- SET OPER=0
- FOR
- SET OPER=$ORDER(^SRF(SRTN,13,OPER))
- IF OPER=""
- QUIT
- DO OTHER
- +1 KILL SROPS,MM,MMM
- IF $LENGTH(SROPER)<50
- SET SROPS(1)=SROPER
- IF $LENGTH(SROPER)>49
- SET SROPER=SROPER_" "
- FOR M=1:1
- DO LOOP
- IF MMM=""
- QUIT
- PRINT ; print results
- +1 IF SRF
- QUIT
- IF $Y+10>IOSL
- DO CODES^SROADOC
- DO PAGE
- IF SRF
- QUIT
- +2 WRITE !,$EXTRACT(SRSDATE,4,5)_"/"_$EXTRACT(SRSDATE,6,7)_"/"_$EXTRACT(SRSDATE,2,3),?10,$PIECE(SRDPT,",")_", "_$EXTRACT($PIECE(SRDPT,",",2)),?26,SROPS(1),?76,SRSUP,?93,SRASA,?124,SRCODE
- +3 WRITE !,SRTN,?10,VA("PID")
- IF $DATA(SROPS(2))
- WRITE ?26,SROPS(2)
- WRITE ?76,SRREL,?93,$EXTRACT(SRTECH,1,20),?120,SRANT_$SELECT(SRANT:" MINS.",1:"")
- +4 WRITE !
- IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
- WRITE "NON-O.R."
- IF $DATA(SROPS(3))
- WRITE ?26,SROPS(3)
- WRITE ?76,SRASS,?93,SRAGNT,!
- +5 IF $DATA(SROPS(4))
- WRITE ?26,SROPS(4),!
- IF $DATA(SROPS(5))
- WRITE ?26,SROPS(5),!
- IF $DATA(SROPS(6))
- WRITE ?26,SROPS(6),!
- +6 QUIT
- HDR IF $DATA(ZTQUEUED)
- DO ^SROSTOP
- IF SRHALT
- SET SRF=1
- QUIT
- +1 IF $Y
- WRITE @IOF
- WRITE !,?(132-$LENGTH(SRINST)\2),SRINST,?120,"PAGE: "_PAGE,!,?58,"SURGICAL SERVICE",?100,"REVIEWED BY:",!,?53,"ANESTHESIA PROVIDER REPORT",?100,"DATE REVIEWED:"
- +2 WRITE !,?(132-$LENGTH(SRFRTO)\2),SRFRTO,?100,"DATE PRINTED: "_SRPRINT
- +3 WRITE !!,"DATE",?10,"PATIENT",?26,"PROCEDURE(S)",?77,"SUPERVISOR",?96,"ASA CLASS",?111,"LEVEL OF SUPERVISION",!,"CASE #",?12,"ID#",?76,"RELIEF ANESTH",?92,"PRINCIPAL TECHNIQUE",?113,"ELAPSED ANES TIME",!,?76,"ASST ANESTH"
- +4 WRITE ?93,"ANESTHESIA AGENT",!
- FOR LINE=1:1:132
- WRITE "="
- +5 SET PAGE=PAGE+1
- IF $DATA(PRIN)
- WRITE !!,?2,"***** "_PRIN_" *****",!
- +6 QUIT
- PAGE IF $EXTRACT(IOST)'="P"
- WRITE !!,"Press RETURN to continue, '^' to quit "
- READ ASK:DTIME
- IF '$TEST!(ASK="^")
- SET SRF=1
- QUIT
- +1 DO HDR
- QUIT
- END IF $EXTRACT(IOST)'="P"
- IF 'SRF
- WRITE !!,"Press RETURN to continue "
- READ X:DTIME
- +1 IF $EXTRACT(IOST)="P"
- WRITE @IOF
- IF $DATA(ZTQUEUED)
- KILL ^TMP("SR",$JOB)
- IF $GET(ZTSTOP)
- QUIT
- SET ZTREQ="@"
- QUIT
- +2 DO ^SRSKILL
- KILL SRTN
- DO ^%ZISC
- WRITE @IOF
- +3 QUIT
- OTHER ; other operations
- +1 SET SRLONG=1
- IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SRTN,13,OPER,0),"^"))>250
- SET SRLONG=0
- SET OPER=999
- SET SROPERS=" ..."
- +2 IF SRLONG
- SET SROPERS=$PIECE(^SRF(SRTN,13,OPER,0),"^")
- +3 SET SROPER=SROPER_$SELECT(SROPERS=" ...":SROPERS,1:", "_SROPERS)
- +4 QUIT
- AGENT SET SRAGNT=$ORDER(^SRF(SRTN,6,SRT,1,0))
- IF SRAGNT=""
- QUIT
- SET SRAGNT=$PIECE(^SRF(SRTN,6,SRT,1,SRAGNT,0),"^")
- Begin DoDot:1
- +1 DO DATA^PSS50(SRAGNT,,,,,"SRRX")
- SET SRAGNT=$PIECE($GET(^TMP($JOB,"SRRX",SRAGNT,.01)),"^")
- KILL ^TMP($JOB,"SRRX",SRAGNT)
- End DoDot:1
- +2 QUIT
- PR SET SRSOUT=0
- DO HDR
- IF SRSOUT
- GOTO END
- SET PRIN=0
- +1 FOR
- SET PRIN=$ORDER(^TMP("SR",$JOB,PRIN))
- IF PRIN=""!(SRF)
- QUIT
- IF $Y+10'>IOSL
- WRITE !!,?2,"***** "_PRIN_" *****",!
- SET DATE=0
- FOR
- SET DATE=$ORDER(^TMP("SR",$JOB,PRIN,DATE))
- IF 'DATE!(SRF)
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^TMP("SR",$JOB,PRIN,DATE,SRTN))
- IF 'SRTN!(SRF)
- QUIT
- DO SET
- +2 IF '$DATA(^TMP("SR",$JOB))
- WRITE $$NODATA^SROUTL0()
- +3 FOR I=$Y:1:(IOSL-8)
- WRITE !
- +4 IF 'SRF
- DO CODES^SROADOC
- +5 GOTO END
- LOOP ; break procedure name if greater than 50 characters
- +1 SET SROPS(M)=""
- FOR LOOP=1:1
- SET MM=$PIECE(SROPER," ")
- SET MMM=$PIECE(SROPER," ",2,200)
- IF MMM=""
- QUIT
- IF $LENGTH(SROPS(M))+$LENGTH(MM)'<50
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT
