- SROOPRM ;B'HAM ISC/KKA - UPDATE NORMAL O.R. HOURS ; [ 07/27/98 2:33 PM ]
- ;;3.0; Surgery ;**11,50**;24 Jun 93
- BEGIN ;
- S SRLINE="" F C=1:1:80 S SRLINE=SRLINE_"="
- LKUPRM ;*****get internal entry number of o.r.*****
- S (SRSOUT,SRCHNG,SRSTOP,SRWRONG)=0,SRSAVE=""
- W @IOF,!,SRLINE,!,?15,"Normal Daily Schedules for Operating Rooms",!,SRLINE,!
- K DIC S DIC=131.7,DIC(0)="QEAMZ",DIC("S")="I $$ORDIV^SROUTL0(+Y,$G(SRSITE(""DIV""))),$P(^SRS(+Y,0),U)",DIC("A")="Enter the name of the operating room: " D ^DIC S SRENT=+Y K DIC G:SRENT<0 END S SRREC=Y(0) W !
- FDAY ;*****start with sunday and follow w/ consec days until user changes
- D SETUP F SRD=0:1:6 Q:SRSOUT!(SRCHNG)!(SRSTOP) S X=SRD D DAY
- I SRCHNG F Q:SRSOUT!(SRSTOP) S SRCHNG=0 D CHNG
- RPTRM G LKUPRM
- END W @IOF D ^SRSKILL Q
- DAY ;*****get internal entry number of day to be edited*****
- K DIC S DIC="^SRS("_SRENT_",4,",DIC(0)="MZ" D ^DIC S SRDAY=+Y K DIC S:SRDAY<0 SRWRONG=1 S:'SRWRONG SREXT=Y(0,0),SRSAVE=$P(Y(0),"^"),SRNEW=SRSAVE+1
- I SRWRONG S SRWRONG=0,X=SRSAVE W !!,"Day entered not valid.",!,"Press RETURN to continue: " R SRANS:DTIME G DAY
- EDIT ;*****dispay heading and choices*****
- Q:SRSOUT W @IOF,!,?10,"Editing the ",SREXT," Schedule for the ",$P(^SC($P(SRREC,"^",1),0),"^",1)," Operating Room",!,SRLINE,!
- S SRNDE=^SRS(SRENT,4,SRDAY,0),SRNST=$P(SRNDE,"^",2),SRNET=$P(SRNDE,"^",3),SRIN=$P(SRNDE,"^",4)
- S:SRNST'="" SRNST=$E(SRNST,1,2)_":"_$E(SRNST,3,4) S:SRNET'="" SRNET=$E(SRNET,1,2)_":"_$E(SRNET,3,4) S:SRIN'="" SRIN=$S(SRIN=0:"NO",SRIN=1:"YES")
- W !,"1. Normal Start Time: ",?24,SRNST,!,"2. Normal End Time: ",?24,SRNET,!,"3. Inactive (Y/N):",?24,SRIN,!!,SRLINE,!
- CHOICE ;*****find out user's choice*****
- S SRGOOD=1
- W !!,"Select information to edit: " R SRCH:DTIME I '$T!(SRCH="^") S SRSOUT=1 Q
- I SRCH["^" S X=$P(SRCH,"^",2),SRCHNG=1 D:$L(X)=1&($E(X)="T") T^SROOPRM1 D:$L(X)=1&($E(X)="S") S^SROOPRM1 S SRCH="^"_X
- JUMP I SRCH["^" S X=$P(SRCH,"^",2) K DIC S DIC="^SRS("_SRENT_",4,",DIC(0)="MZ" D ^DIC K DIC S X=$P(Y,"^",2) D:X="" SETUP G:X="" JUMP G DAY
- S:X=6 SRSTOP=1 S:($E(X,1,2))="SA" SRSTOP=1
- Q:SRCH="" I SRCH="A"!(SRCH="ALL") S SRCH="1:3"
- I SRCH'[":",(SRCH'?1N) D HELP^SROOPRM1 Q:SRSOUT G EDIT
- I SRCH?1N S SRCKNM=SRCH I SRCKNM<1!(SRCKNM>3)!($E(SRCKNM)'=SRCKNM) D HELP^SROOPRM1 Q:SRSOUT G EDIT
- I SRCH[":" S SR1=$P(SRCH,":"),SR2=$P(SRCH,":",2) I SR1<1!(SR2>3)!(SR1>SR2) D HELP^SROOPRM1 Q:SRSOUT G EDIT
- I SRCH[":" W !! D PL G EDIT
- S SRNUM=SRCH W !! D UPDATE G EDIT
- G LKUPRM
- Q
- PL ;*****update more than one characteristic*****
- F SRC=SR1:1:SR2 S SRNUM=SRC D UPDATE Q:SRSOUT
- Q
- UPDATE ;*****update one characteristic*****
- K DA,DIE,DR S DIE="^SRS("_SRENT_",4,",DA(1)=SRENT,DA=SRDAY,DR=SRNUM_"T" D ^DIE K DA,DIE,DR
- I SRNUM=1,$P(^SRS(SRENT,4,SRDAY,0),"^",2)'="",$P(^(0),"^",3)'="",$P(^(0),"^",2)'<$P(^(0),"^",3) W !!,"Normal Starting Time must be earlier than Normal Ending Time.",! D DEL G UPDATE
- I SRNUM=2,$P(^SRS(SRENT,4,SRDAY,0),"^",3)'="",$P(^(0),"^",2)'="",$P(^(0),"^",3)'>$P(^(0),"^",2) W !!,"Normal Ending Time must be later than Normal Starting Time.",! D DEL G UPDATE
- Q
- CHNG ;*****loop through days of week starting with user's day of choice***
- F SRNEWC=SRNEW:1:6 Q:SRCHNG!(SRSOUT)!(SRSTOP) S X=SRNEWC D DAY
- Q
- DEL ; delete absurd times
- S DIE="^SRS("_SRENT_",4,",DA(1)=SRENT,DA=SRDAY,DR=SRNUM_"///@" D ^DIE
- Q
- SETUP ; add the days of the week if they do not exist
- F SRDAY=0:1:6 I '$D(^SRS(SRENT,4,"B",SRDAY)) K DA,DD,DO,DIC S DIC="^SRS("_SRENT_",4,",DIC(0)="LMZ",DIC("P")=$P(^DD(131.7,11,0),"^",2),DA(1)=SRENT,X=SRDAY D FILE^DICN
- K DA,DIC,DD,DO
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROOPRM 3598 printed Jan 18, 2025@03:45:53 Page 2
- SROOPRM ;B'HAM ISC/KKA - UPDATE NORMAL O.R. HOURS ; [ 07/27/98 2:33 PM ]
- +1 ;;3.0; Surgery ;**11,50**;24 Jun 93
- BEGIN ;
- +1 SET SRLINE=""
- FOR C=1:1:80
- SET SRLINE=SRLINE_"="
- LKUPRM ;*****get internal entry number of o.r.*****
- +1 SET (SRSOUT,SRCHNG,SRSTOP,SRWRONG)=0
- SET SRSAVE=""
- +2 WRITE @IOF,!,SRLINE,!,?15,"Normal Daily Schedules for Operating Rooms",!,SRLINE,!
- +3 KILL DIC
- SET DIC=131.7
- SET DIC(0)="QEAMZ"
- SET DIC("S")="I $$ORDIV^SROUTL0(+Y,$G(SRSITE(""DIV""))),$P(^SRS(+Y,0),U)"
- SET DIC("A")="Enter the name of the operating room: "
- DO ^DIC
- SET SRENT=+Y
- KILL DIC
- if SRENT<0
- GOTO END
- SET SRREC=Y(0)
- WRITE !
- FDAY ;*****start with sunday and follow w/ consec days until user changes
- +1 DO SETUP
- FOR SRD=0:1:6
- if SRSOUT!(SRCHNG)!(SRSTOP)
- QUIT
- SET X=SRD
- DO DAY
- +2 IF SRCHNG
- FOR
- if SRSOUT!(SRSTOP)
- QUIT
- SET SRCHNG=0
- DO CHNG
- RPTRM GOTO LKUPRM
- END WRITE @IOF
- DO ^SRSKILL
- QUIT
- DAY ;*****get internal entry number of day to be edited*****
- +1 KILL DIC
- SET DIC="^SRS("_SRENT_",4,"
- SET DIC(0)="MZ"
- DO ^DIC
- SET SRDAY=+Y
- KILL DIC
- if SRDAY<0
- SET SRWRONG=1
- if 'SRWRONG
- SET SREXT=Y(0,0)
- SET SRSAVE=$PIECE(Y(0),"^")
- SET SRNEW=SRSAVE+1
- +2 IF SRWRONG
- SET SRWRONG=0
- SET X=SRSAVE
- WRITE !!,"Day entered not valid.",!,"Press RETURN to continue: "
- READ SRANS:DTIME
- GOTO DAY
- EDIT ;*****dispay heading and choices*****
- +1 if SRSOUT
- QUIT
- WRITE @IOF,!,?10,"Editing the ",SREXT," Schedule for the ",$PIECE(^SC($PIECE(SRREC,"^",1),0),"^",1)," Operating Room",!,SRLINE,!
- +2 SET SRNDE=^SRS(SRENT,4,SRDAY,0)
- SET SRNST=$PIECE(SRNDE,"^",2)
- SET SRNET=$PIECE(SRNDE,"^",3)
- SET SRIN=$PIECE(SRNDE,"^",4)
- +3 if SRNST'=""
- SET SRNST=$EXTRACT(SRNST,1,2)_":"_$EXTRACT(SRNST,3,4)
- if SRNET'=""
- SET SRNET=$EXTRACT(SRNET,1,2)_":"_$EXTRACT(SRNET,3,4)
- if SRIN'=""
- SET SRIN=$SELECT(SRIN=0:"NO",SRIN=1:"YES")
- +4 WRITE !,"1. Normal Start Time: ",?24,SRNST,!,"2. Normal End Time: ",?24,SRNET,!,"3. Inactive (Y/N):",?24,SRIN,!!,SRLINE,!
- CHOICE ;*****find out user's choice*****
- +1 SET SRGOOD=1
- +2 WRITE !!,"Select information to edit: "
- READ SRCH:DTIME
- IF '$TEST!(SRCH="^")
- SET SRSOUT=1
- QUIT
- +3 IF SRCH["^"
- SET X=$PIECE(SRCH,"^",2)
- SET SRCHNG=1
- if $LENGTH(X)=1&($EXTRACT(X)="T")
- DO T^SROOPRM1
- if $LENGTH(X)=1&($EXTRACT(X)="S")
- DO S^SROOPRM1
- SET SRCH="^"_X
- JUMP IF SRCH["^"
- SET X=$PIECE(SRCH,"^",2)
- KILL DIC
- SET DIC="^SRS("_SRENT_",4,"
- SET DIC(0)="MZ"
- DO ^DIC
- KILL DIC
- SET X=$PIECE(Y,"^",2)
- if X=""
- DO SETUP
- if X=""
- GOTO JUMP
- GOTO DAY
- +1 if X=6
- SET SRSTOP=1
- if ($EXTRACT(X,1,2))="SA"
- SET SRSTOP=1
- +2 if SRCH=""
- QUIT
- IF SRCH="A"!(SRCH="ALL")
- SET SRCH="1:3"
- +3 IF SRCH'[":"
- IF (SRCH'?1N)
- DO HELP^SROOPRM1
- if SRSOUT
- QUIT
- GOTO EDIT
- +4 IF SRCH?1N
- SET SRCKNM=SRCH
- IF SRCKNM<1!(SRCKNM>3)!($EXTRACT(SRCKNM)'=SRCKNM)
- DO HELP^SROOPRM1
- if SRSOUT
- QUIT
- GOTO EDIT
- +5 IF SRCH[":"
- SET SR1=$PIECE(SRCH,":")
- SET SR2=$PIECE(SRCH,":",2)
- IF SR1<1!(SR2>3)!(SR1>SR2)
- DO HELP^SROOPRM1
- if SRSOUT
- QUIT
- GOTO EDIT
- +6 IF SRCH[":"
- WRITE !!
- DO PL
- GOTO EDIT
- +7 SET SRNUM=SRCH
- WRITE !!
- DO UPDATE
- GOTO EDIT
- +8 GOTO LKUPRM
- +9 QUIT
- PL ;*****update more than one characteristic*****
- +1 FOR SRC=SR1:1:SR2
- SET SRNUM=SRC
- DO UPDATE
- if SRSOUT
- QUIT
- +2 QUIT
- UPDATE ;*****update one characteristic*****
- +1 KILL DA,DIE,DR
- SET DIE="^SRS("_SRENT_",4,"
- SET DA(1)=SRENT
- SET DA=SRDAY
- SET DR=SRNUM_"T"
- DO ^DIE
- KILL DA,DIE,DR
- +2 IF SRNUM=1
- IF $PIECE(^SRS(SRENT,4,SRDAY,0),"^",2)'=""
- IF $PIECE(^(0),"^",3)'=""
- IF $PIECE(^(0),"^",2)'<$PIECE(^(0),"^",3)
- WRITE !!,"Normal Starting Time must be earlier than Normal Ending Time.",!
- DO DEL
- GOTO UPDATE
- +3 IF SRNUM=2
- IF $PIECE(^SRS(SRENT,4,SRDAY,0),"^",3)'=""
- IF $PIECE(^(0),"^",2)'=""
- IF $PIECE(^(0),"^",3)'>$PIECE(^(0),"^",2)
- WRITE !!,"Normal Ending Time must be later than Normal Starting Time.",!
- DO DEL
- GOTO UPDATE
- +4 QUIT
- CHNG ;*****loop through days of week starting with user's day of choice***
- +1 FOR SRNEWC=SRNEW:1:6
- if SRCHNG!(SRSOUT)!(SRSTOP)
- QUIT
- SET X=SRNEWC
- DO DAY
- +2 QUIT
- DEL ; delete absurd times
- +1 SET DIE="^SRS("_SRENT_",4,"
- SET DA(1)=SRENT
- SET DA=SRDAY
- SET DR=SRNUM_"///@"
- DO ^DIE
- +2 QUIT
- SETUP ; add the days of the week if they do not exist
- +1 FOR SRDAY=0:1:6
- IF '$DATA(^SRS(SRENT,4,"B",SRDAY))
- KILL DA,DD,DO,DIC
- SET DIC="^SRS("_SRENT_",4,"
- SET DIC(0)="LMZ"
- SET DIC("P")=$PIECE(^DD(131.7,11,0),"^",2)
- SET DA(1)=SRENT
- SET X=SRDAY
- DO FILE^DICN
- +2 KILL DA,DIC,DD,DO
- +3 QUIT