- SROREQ1 ;BIR/MAM - REQUESTS FOR A DAY (LONG FORM) ; [ 12/09/99 11:54 AM ]
- ;;3.0; Surgery ;**48,77,92,109**;24 Jun 93
- ;
- ; Reference to ^LAB(66 supported by DBIA #210
- ;
- BEG ; entry when queued
- K ^TMP("SR",$J) U IO S Y=SRSDATE D D^DIQ S SRSDT=Y
- W @IOF S (SRSOUT,DFN)=0 F S DFN=$O(^SRF("AR",SRSDATE,DFN)) Q:'DFN S SRTN=0 F S SRTN=$O(^SRF("AR",SRSDATE,DFN,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN) D SET
- S (SRSNM,SRHDR)=0 F S SRSNM=$O(^TMP("SR",$J,SRSNM)) Q:SRSNM=""!SRSOUT D PAGE S SREQDT=0 F S SREQDT=$O(^TMP("SR",$J,SRSNM,SREQDT)) Q:SREQDT=""!(SRSOUT) D MORE
- END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q
- I 'SRSOUT,$E(IOST)'="P" W !!,"Press RETURN to continue " R X:DTIME
- D ^%ZISC W @IOF K SRTN D ^SRSKILL
- Q
- MORE S SRTN=0 F S SRTN=$O(^TMP("SR",$J,SRSNM,SREQDT,SRTN)) Q:'SRTN!(SRSOUT) D PRINT
- Q
- SET ; set ^TMP(
- S SRSS=$P(^SRF(SRTN,0),"^",4),SRSNM=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"UNKNOWN")
- S SREQDT=$P($G(^SRF(SRTN,"1.0")),"^",11) S:'SREQDT SREQDT="ZZ" S ^TMP("SR",$J,SRSNM,SREQDT,SRTN)=DFN
- Q
- PRINT ; print requests
- I $Y+20>IOSL D PAGE I SRSOUT Q
- S DFN=^TMP("SR",$J,SRSNM,SREQDT,SRTN) D DEM^VADPT S SRNAME=VADM(1),SRSSN=VA("PID"),SRWARD=$S($D(^DPT(DFN,.1)):^(.1),1:"NOT ENTERED"),AGE=VADM(4)
- S SR(.1)=$S($D(^SRF(SRTN,.1)):^(.1),1:"")
- S SROSUR=$P(SR(.1),"^",4),SROATT=$P(SR(.1),"^",13),SROPER=$P(^SRF(SRTN,"OP"),"^") K SROP S (X,CNT)=0 F S X=$O(^SRF(SRTN,13,X)) Q:'X S CNT=CNT+1,SROP(CNT)=$P(^SRF(SRTN,13,X,0),"^")
- K SROPS,MM,MMM S:$L(SROPER)<56 SROPS(1)=SROPER I $L(SROPER)>55 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
- S:SROSUR SROSUR=$P(^VA(200,SROSUR,0),"^") I SROATT S SROATT=$P(^VA(200,SROATT,0),"^")
- S SRDIAG=$S($D(^SRF(SRTN,33)):$P(^(33),"^"),1:"") I SRDIAG="" S SRDIAG="NOT ENTERED"
- S Y=SREQDT D D^DIQ S SREQDAY=$S('$E(Y):$E(Y,1,12)_" "_$E(Y,14,18),1:"") S SR("1.0")=$G(^SRF(SRTN,"1.0"))
- S SRSPER=$P(SR("1.0"),"^",10) S:SRSPER SRSPER=$P(^VA(200,SRSPER,0),"^")
- ANES S Y=$P(SR("1.0"),"^"),C=$P(^DD(130,1.01,0),"^",2) D:Y'="" Y^DIQ S SRANES=$S(Y'="":Y,1:"NOT ENTERED")
- K BLOOD S (CNT,X)=0 F S X=$O(^SRF(SRTN,11,X)) Q:'X S CNT=CNT+1,Y=$P(^SRF(SRTN,11,X,0),"^"),MM=$P(^(0),"^",2) S BLOOD(CNT)=Y_" "_MM_" UNITS" ;RLM
- K SRPOS S (X,CNT)=0 F S X=$O(^SRF(SRTN,42,X)) Q:'X S CNT=CNT+1,Y=$P(^SRF(SRTN,42,X,0),"^"),SRPOS(CNT)=$P(^SRO(132,Y,0),"^")
- S SRLENGTH=$P($G(^SRF(SRTN,.4)),"^") I SRLENGTH="" S SRLENGTH="NOT ENTERED"
- S SRORDER=$P(^SRF(SRTN,0),"^",11)
- W ! F LINE=1:1:80 W "-"
- W !!,"Patient: "_SRNAME,?40,"ID #: "_VA("PID"),!,"Age: "_AGE,?40,"Ward: "_SRWARD,!!,"Surgeon: "_SROSUR,?40,"Attending: "_SROATT,!,"Preoperative Diagnosis: "_SRDIAG
- W !!,"Principal Procedure:",?22,SROPS(1) I $D(SROPS(2)) W !,?22,SROPS(2) I $D(SROPS(3)) W !,?22,SROPS(3) I $D(SROPS(4)) W !,?22,SROPS(4) I $D(SROPS(5)) W !,?22,SROPS(5)
- I $O(SROP(0)) W !,"Other Procedures:",?22,SROP(1) S CNT=1 F S CNT=$O(SROP(CNT)) Q:'CNT W !,?22,SROP(CNT)
- W !,"Estimated Case Length: "_SRLENGTH I $O(SRPOS(0)) W ?40,"Position: ",SRPOS(1) I $D(SRPOS(2)) W !,?50,SRPOS(2) I $D(SRPOS(3)) W !,?50,SRPOS(3) I $D(SRPOS(4)) W !,?50,SRPOS(4)
- I SRORDER'="" W !,"Case Schedule Order: "_SRORDER
- W !,"Requested Anesthesia Technique: "_SRANES
- I $O(BLOOD(0)) W !!,"Blood Requested: ",?18,BLOOD(1) I $D(BLOOD(2)) W !,?18,BLOOD(2) I $D(BLOOD(3)) W !,?18,BLOOD(3)
- I SRSPER'="" W !!,"Requested by: "_SRSPER W:SREQDAY'="" " on "_SREQDAY
- I $O(^SRF(SRTN,5,0)) W !!,"Comments: " S X=0 F S X=$O(^SRF(SRTN,5,X)) Q:'X W !,^SRF(SRTN,5,X,0)
- W ! Q
- PAGE I SRHDR,$E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I X["^" S SRSOUT=1 Q
- D HDR^SROREQ Q
- LOOP ; break procedure if greater than 55 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)'<55 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROREQ1 3871 printed Feb 19, 2025@00:12:15 Page 2
- SROREQ1 ;BIR/MAM - REQUESTS FOR A DAY (LONG FORM) ; [ 12/09/99 11:54 AM ]
- +1 ;;3.0; Surgery ;**48,77,92,109**;24 Jun 93
- +2 ;
- +3 ; Reference to ^LAB(66 supported by DBIA #210
- +4 ;
- BEG ; entry when queued
- +1 KILL ^TMP("SR",$JOB)
- USE IO
- SET Y=SRSDATE
- DO D^DIQ
- SET SRSDT=Y
- +2 WRITE @IOF
- SET (SRSOUT,DFN)=0
- FOR
- SET DFN=$ORDER(^SRF("AR",SRSDATE,DFN))
- if 'DFN
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("AR",SRSDATE,DFN,SRTN))
- if 'SRTN
- QUIT
- IF $DATA(^SRF(SRTN,0))
- IF $$DIV^SROUTL0(SRTN)
- DO SET
- +3 SET (SRSNM,SRHDR)=0
- FOR
- SET SRSNM=$ORDER(^TMP("SR",$JOB,SRSNM))
- if SRSNM=""!SRSOUT
- QUIT
- DO PAGE
- SET SREQDT=0
- FOR
- SET SREQDT=$ORDER(^TMP("SR",$JOB,SRSNM,SREQDT))
- if SREQDT=""!(SRSOUT)
- QUIT
- DO MORE
- END if $EXTRACT(IOST)="P"
- WRITE @IOF
- IF $DATA(ZTQUEUED)
- KILL ^TMP("SR",$JOB)
- if $GET(ZTSTOP)
- QUIT
- SET ZTREQ="@"
- QUIT
- +1 IF 'SRSOUT
- IF $EXTRACT(IOST)'="P"
- WRITE !!,"Press RETURN to continue "
- READ X:DTIME
- +2 DO ^%ZISC
- WRITE @IOF
- KILL SRTN
- DO ^SRSKILL
- +3 QUIT
- MORE SET SRTN=0
- FOR
- SET SRTN=$ORDER(^TMP("SR",$JOB,SRSNM,SREQDT,SRTN))
- if 'SRTN!(SRSOUT)
- QUIT
- DO PRINT
- +1 QUIT
- SET ; set ^TMP(
- +1 SET SRSS=$PIECE(^SRF(SRTN,0),"^",4)
- SET SRSNM=$SELECT(SRSS:$PIECE(^SRO(137.45,SRSS,0),"^"),1:"UNKNOWN")
- +2 SET SREQDT=$PIECE($GET(^SRF(SRTN,"1.0")),"^",11)
- if 'SREQDT
- SET SREQDT="ZZ"
- SET ^TMP("SR",$JOB,SRSNM,SREQDT,SRTN)=DFN
- +3 QUIT
- PRINT ; print requests
- +1 IF $Y+20>IOSL
- DO PAGE
- IF SRSOUT
- QUIT
- +2 SET DFN=^TMP("SR",$JOB,SRSNM,SREQDT,SRTN)
- DO DEM^VADPT
- SET SRNAME=VADM(1)
- SET SRSSN=VA("PID")
- SET SRWARD=$SELECT($DATA(^DPT(DFN,.1)):^(.1),1:"NOT ENTERED")
- SET AGE=VADM(4)
- +3 SET SR(.1)=$SELECT($DATA(^SRF(SRTN,.1)):^(.1),1:"")
- +4 SET SROSUR=$PIECE(SR(.1),"^",4)
- SET SROATT=$PIECE(SR(.1),"^",13)
- SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
- KILL SROP
- SET (X,CNT)=0
- FOR
- SET X=$ORDER(^SRF(SRTN,13,X))
- if 'X
- QUIT
- SET CNT=CNT+1
- SET SROP(CNT)=$PIECE(^SRF(SRTN,13,X,0),"^")
- +5 KILL SROPS,MM,MMM
- if $LENGTH(SROPER)<56
- SET SROPS(1)=SROPER
- IF $LENGTH(SROPER)>55
- SET SROPER=SROPER_" "
- FOR M=1:1
- DO LOOP
- if MMM=""
- QUIT
- +6 if SROSUR
- SET SROSUR=$PIECE(^VA(200,SROSUR,0),"^")
- IF SROATT
- SET SROATT=$PIECE(^VA(200,SROATT,0),"^")
- +7 SET SRDIAG=$SELECT($DATA(^SRF(SRTN,33)):$PIECE(^(33),"^"),1:"")
- IF SRDIAG=""
- SET SRDIAG="NOT ENTERED"
- +8 SET Y=SREQDT
- DO D^DIQ
- SET SREQDAY=$SELECT('$EXTRACT(Y):$EXTRACT(Y,1,12)_" "_$EXTRACT(Y,14,18),1:"")
- SET SR("1.0")=$GET(^SRF(SRTN,"1.0"))
- +9 SET SRSPER=$PIECE(SR("1.0"),"^",10)
- if SRSPER
- SET SRSPER=$PIECE(^VA(200,SRSPER,0),"^")
- ANES SET Y=$PIECE(SR("1.0"),"^")
- SET C=$PIECE(^DD(130,1.01,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRANES=$SELECT(Y'="":Y,1:"NOT ENTERED")
- +1 ;RLM
- KILL BLOOD
- SET (CNT,X)=0
- FOR
- SET X=$ORDER(^SRF(SRTN,11,X))
- if 'X
- QUIT
- SET CNT=CNT+1
- SET Y=$PIECE(^SRF(SRTN,11,X,0),"^")
- SET MM=$PIECE(^(0),"^",2)
- SET BLOOD(CNT)=Y_" "_MM_" UNITS"
- +2 KILL SRPOS
- SET (X,CNT)=0
- FOR
- SET X=$ORDER(^SRF(SRTN,42,X))
- if 'X
- QUIT
- SET CNT=CNT+1
- SET Y=$PIECE(^SRF(SRTN,42,X,0),"^")
- SET SRPOS(CNT)=$PIECE(^SRO(132,Y,0),"^")
- +3 SET SRLENGTH=$PIECE($GET(^SRF(SRTN,.4)),"^")
- IF SRLENGTH=""
- SET SRLENGTH="NOT ENTERED"
- +4 SET SRORDER=$PIECE(^SRF(SRTN,0),"^",11)
- +5 WRITE !
- FOR LINE=1:1:80
- WRITE "-"
- +6 WRITE !!,"Patient: "_SRNAME,?40,"ID #: "_VA("PID"),!,"Age: "_AGE,?40,"Ward: "_SRWARD,!!,"Surgeon: "_SROSUR,?40,"Attending: "_SROATT,!,"Preoperative Diagnosis: "_SRDIAG
- +7 WRITE !!,"Principal Procedure:",?22,SROPS(1)
- IF $DATA(SROPS(2))
- WRITE !,?22,SROPS(2)
- IF $DATA(SROPS(3))
- WRITE !,?22,SROPS(3)
- IF $DATA(SROPS(4))
- WRITE !,?22,SROPS(4)
- IF $DATA(SROPS(5))
- WRITE !,?22,SROPS(5)
- +8 IF $ORDER(SROP(0))
- WRITE !,"Other Procedures:",?22,SROP(1)
- SET CNT=1
- FOR
- SET CNT=$ORDER(SROP(CNT))
- if 'CNT
- QUIT
- WRITE !,?22,SROP(CNT)
- +9 WRITE !,"Estimated Case Length: "_SRLENGTH
- IF $ORDER(SRPOS(0))
- WRITE ?40,"Position: ",SRPOS(1)
- IF $DATA(SRPOS(2))
- WRITE !,?50,SRPOS(2)
- IF $DATA(SRPOS(3))
- WRITE !,?50,SRPOS(3)
- IF $DATA(SRPOS(4))
- WRITE !,?50,SRPOS(4)
- +10 IF SRORDER'=""
- WRITE !,"Case Schedule Order: "_SRORDER
- +11 WRITE !,"Requested Anesthesia Technique: "_SRANES
- +12 IF $ORDER(BLOOD(0))
- WRITE !!,"Blood Requested: ",?18,BLOOD(1)
- IF $DATA(BLOOD(2))
- WRITE !,?18,BLOOD(2)
- IF $DATA(BLOOD(3))
- WRITE !,?18,BLOOD(3)
- +13 IF SRSPER'=""
- WRITE !!,"Requested by: "_SRSPER
- if SREQDAY'=""
- WRITE " on "_SREQDAY
- +14 IF $ORDER(^SRF(SRTN,5,0))
- WRITE !!,"Comments: "
- SET X=0
- FOR
- SET X=$ORDER(^SRF(SRTN,5,X))
- if 'X
- QUIT
- WRITE !,^SRF(SRTN,5,X,0)
- +15 WRITE !
- QUIT
- PAGE IF SRHDR
- IF $EXTRACT(IOST)'="P"
- WRITE !!,"Press RETURN to continue, or '^' to quit: "
- READ X:DTIME
- IF X["^"
- SET SRSOUT=1
- QUIT
- +1 DO HDR^SROREQ
- QUIT
- LOOP ; break procedure if greater than 55 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)'<55
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT