SRSCHDA ;B'HAM ISC/MAM - SCHEDULE ANESTHESIA PERSONNEL;[JAN 31,2001@07:58]
;;3.0;Surgery ;**77,50,100,201**;24 Jun 93;Build 5
I $D(SRTN) S SRCASE=SRTN
DATE W ! K %DT S %DT="AEFX",%DT("A")="Schedule Anesthesia Personnel for which Date ? " D ^%DT G:Y<0 END S SRSDATE=+Y K %DT
S X1=SRSDATE,X2="+1" D C^%DTC S SRSD1=X
OR W ! K DIC S SRZ=0,DIC("S")="I $$ORDIV^SROUTL0(+Y,$G(SRSITE(""DIV""))),'$P(^(0),""^"",6)",DIC=131.7,DIC(0)="QEAMZ",DIC("A")="Schedule Anesthesia Personnel for which Operating Room ? " D ^DIC G:Y<0 END S SROR=+Y,SROR("N")=Y(0,0)
I '$O(^SRF("AMM",SROR,SRSDATE-.0001))!($O(^SRF("AMM",SROR,SRSDATE-.0001))>SRSD1) W !!,"There are no cases scheduled for this operating room. ",!!,"Press RETURN to continue " R X:DTIME
S (SRANES(1),SRANES(2))=""
S SRSD=SRSDATE-.0001 F S SRSD=$O(^SRF("AMM",SROR,SRSD)) Q:'SRSD!(SRSD>SRSD1) S SRTN=0 F S SRTN=$O(^SRF("AMM",SROR,SRSD,SRTN)) Q:'SRTN D LIST
W @IOF
AGAIN W !!,"Would you like to continue with another operating room ? YES// " R X:DTIME S:'$T X="^" I X["?" W !!,"Enter RETURN if you would like to schedule anesthesia personnel in another",!,"room, or 'NO' to quit." G AGAIN
I X["^" G END
S X=$E(X) I "YyNn"'[X W !!,"Please answer 'YES' or 'NO'." G AGAIN
I "Yy"[X G OR
END K SRTN I $D(SRCASE) S SRTN=SRCASE
D ^SRSKILL W @IOF
Q
LIST ; set variables and list case
Q:SRZ K SROPS,MM,MMM S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRNM=VADM(1),SROPER=$P(^SRF(SRTN,"OP"),"^") S:$L(SROPER)<70 SROPS(1)=SROPER I $L(SROPER)>69 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
S SRST=$P(^SRF(SRTN,31),"^",4),SRET=$P(^(31),"^",5),SRST=$P(SRST,".",2)_"0000",SRST=$E(SRST,1,2)_":"_$E(SRST,3,4),SRET=$P(SRET,".",2)_"0000",SRET=$E(SRET,1,2)_":"_$E(SRET,3,4)
W @IOF,!!,"Scheduled Operations for "_SROR("N"),! F LINE=1:1:80 W "-"
W !!,"Case # "_SRTN_" Patient: "_SRNM,!,"From: "_SRST_" To: "_SRET,!,SROPS(1) I $D(SROPS(2)) W !,?5,SROPS(2) I $D(SROPS(3)) W !,?5,SROPS(3)
K DR,SRODR
;Modified for SR*3.0*201: call to SRSCHD1 LOCK/UNLOCK procedures
I '$$LOCK^SRSCHD1(SRTN) G MORE
W !! S DA=SRTN,DIE=130,DR="1.01T;.31T//"_SRANES(1)_";S SRANES(1)=$S(X:$P(^VA(200,X,0),""^""),1:X);.34T//"_SRANES(2)_";S SRANES(2)=$S(X:$P(^VA(200,X,0),""^""),1:X)" D ^DIE K DR
I $D(SRODR) S SRNOCON=1 D ^SROCON1 K SRNOCON
D UNLOCK^SRSCHD1(SRTN)
MORE W !!!,"Press RETURN to continue, or '^' to quit: " R X:DTIME S:'$T X="^" I X["?" W !!,"Enter RETURN to continue scheduling other cases, or '^' to leave this option.",!! G MORE
I X["^" S SRZ=1
Q
LOOP ; break procedure if greater than 70 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)'<70 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCHDA 2722 printed Dec 13, 2024@02:47:14 Page 2
SRSCHDA ;B'HAM ISC/MAM - SCHEDULE ANESTHESIA PERSONNEL;[JAN 31,2001@07:58]
+1 ;;3.0;Surgery ;**77,50,100,201**;24 Jun 93;Build 5
+2 IF $DATA(SRTN)
SET SRCASE=SRTN
DATE WRITE !
KILL %DT
SET %DT="AEFX"
SET %DT("A")="Schedule Anesthesia Personnel for which Date ? "
DO ^%DT
if Y<0
GOTO END
SET SRSDATE=+Y
KILL %DT
+1 SET X1=SRSDATE
SET X2="+1"
DO C^%DTC
SET SRSD1=X
OR WRITE !
KILL DIC
SET SRZ=0
SET DIC("S")="I $$ORDIV^SROUTL0(+Y,$G(SRSITE(""DIV""))),'$P(^(0),""^"",6)"
SET DIC=131.7
SET DIC(0)="QEAMZ"
SET DIC("A")="Schedule Anesthesia Personnel for which Operating Room ? "
DO ^DIC
if Y<0
GOTO END
SET SROR=+Y
SET SROR("N")=Y(0,0)
+1 IF '$ORDER(^SRF("AMM",SROR,SRSDATE-.0001))!($ORDER(^SRF("AMM",SROR,SRSDATE-.0001))>SRSD1)
WRITE !!,"There are no cases scheduled for this operating room. ",!!,"Press RETURN to continue "
READ X:DTIME
+2 SET (SRANES(1),SRANES(2))=""
+3 SET SRSD=SRSDATE-.0001
FOR
SET SRSD=$ORDER(^SRF("AMM",SROR,SRSD))
if 'SRSD!(SRSD>SRSD1)
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AMM",SROR,SRSD,SRTN))
if 'SRTN
QUIT
DO LIST
+4 WRITE @IOF
AGAIN WRITE !!,"Would you like to continue with another operating room ? YES// "
READ X:DTIME
if '$TEST
SET X="^"
IF X["?"
WRITE !!,"Enter RETURN if you would like to schedule anesthesia personnel in another",!,"room, or 'NO' to quit."
GOTO AGAIN
+1 IF X["^"
GOTO END
+2 SET X=$EXTRACT(X)
IF "YyNn"'[X
WRITE !!,"Please answer 'YES' or 'NO'."
GOTO AGAIN
+3 IF "Yy"[X
GOTO OR
END KILL SRTN
IF $DATA(SRCASE)
SET SRTN=SRCASE
+1 DO ^SRSKILL
WRITE @IOF
+2 QUIT
LIST ; set variables and list case
+1 if SRZ
QUIT
KILL SROPS,MM,MMM
SET DFN=$PIECE(^SRF(SRTN,0),"^")
DO DEM^VADPT
SET SRNM=VADM(1)
SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
if $LENGTH(SROPER)<70
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>69
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+2 SET SRST=$PIECE(^SRF(SRTN,31),"^",4)
SET SRET=$PIECE(^(31),"^",5)
SET SRST=$PIECE(SRST,".",2)_"0000"
SET SRST=$EXTRACT(SRST,1,2)_":"_$EXTRACT(SRST,3,4)
SET SRET=$PIECE(SRET,".",2)_"0000"
SET SRET=$EXTRACT(SRET,1,2)_":"_$EXTRACT(SRET,3,4)
+3 WRITE @IOF,!!,"Scheduled Operations for "_SROR("N"),!
FOR LINE=1:1:80
WRITE "-"
+4 WRITE !!,"Case # "_SRTN_" Patient: "_SRNM,!,"From: "_SRST_" To: "_SRET,!,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?5,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?5,SROPS(3)
+5 KILL DR,SRODR
+6 ;Modified for SR*3.0*201: call to SRSCHD1 LOCK/UNLOCK procedures
+7 IF '$$LOCK^SRSCHD1(SRTN)
GOTO MORE
+8 WRITE !!
SET DA=SRTN
SET DIE=130
SET DR="1.01T;.31T//"_SRANES(1)_";S SRANES(1)=$S(X:$P(^VA(200,X,0),""^""),1:X);.34T//"_SRANES(2)_";S SRANES(2)=$S(X:$P(^VA(200,X,0),""^""),1:X)"
DO ^DIE
KILL DR
+9 IF $DATA(SRODR)
SET SRNOCON=1
DO ^SROCON1
KILL SRNOCON
+10 DO UNLOCK^SRSCHD1(SRTN)
MORE WRITE !!!,"Press RETURN to continue, or '^' to quit: "
READ X:DTIME
if '$TEST
SET X="^"
IF X["?"
WRITE !!,"Enter RETURN to continue scheduling other cases, or '^' to leave this option.",!!
GOTO MORE
+1 IF X["^"
SET SRZ=1
+2 QUIT
LOOP ; break procedure if greater than 70 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)'<70
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
