- 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 Jan 18, 2025@03:48:25 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