ECTPP ;B'ham ISC/PTD-Enter/Edit Staffing Data for Pay Period ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
I '$O(^ECC(730,"ALS",0)) W *7,!!?29,"OPTION IS UNAVAILABLE!",!,"Local services have not been identified!",!,"Use the 'Identify Station's Services' option.",!! S XQUIT="" Q
S CNT=-1 F J=0:0 S J=$O(^ECC(730,"ALS",J)) S CNT=CNT+1 Q:'J
I CNT<8 W *7,!!?25,"WARNING",!,"You have only ",CNT," services defined for your station!",!,"Use the 'Identify Station's Services' option to verify before you continue."
;
CHS W !!,"At this time, you may:",!!,"1. Enter data for a new pay period",!,"2. Edit existing data for a previously entered pay period",!,"3. Delete a pay period entered in error",!!,"Choose a number (1 - 3): "
R CHS:DTIME G:'$T!("^"[CHS) EXIT I CHS'?1N!(CHS<1)!(CHS>3) W !!,*7,"You MUST answer with a number between 1 and 3." G CHS
;BRANCH BASED ON ENTER/EDIT CHOICE
I CHS=2 D EDIT G EXIT
I CHS=3 D DIK G EXIT
ENTER ;IF CHOICE 1 WAS SELECTED, CREATE NEW ENTRY WITH ASSOCIATED SERVICES
PP R !!,"Enter Pay Period: ",PP:DTIME G:'$T!("^"[PP) EXIT I (PP'?.N)!(PP<1)!(PP>27) W !!,*7,"You MUST answer with a number between 1 and 27." G PP
S:$L(PP)=1 PP="0"_PP
YR W ! S %DT="AE",%DT("A")="Enter calendar year associated with this pay period: ",%DT(0)=2000000 D ^%DT G:$D(DTOUT)!("^"[X) EXIT S YR=$E(Y,1,3),YRPP=YR_PP
W ! S DIR(0)="Y",DIR("A")="Is this correct ==> Year: "_(1700+YR)_" Pay Period: "_PP,DIR("B")="YES",DIR("?")="Enter 'Y' if this is correct, 'N' or <RETURN> to exit." D ^DIR
G:$D(DTOUT)!$D(DUOUT)!(Y=0) EXIT
I $D(^ECT(731.7,YRPP)) S DA=YRPP W !!,"This is an EXISTING entry. You may edit if you wish.",!! D DIE G EXIT
DIC S (DIC,DIE)="^ECT(731.7,",DIC(0)="LM",X=YRPP,DLAYGO=731.7 D ^DIC K DIC G:Y<0 EXIT S DA=+Y,DR="1" D ^DIE K DIE
I '$D(^ECT(731.7,YRPP,1,0)) S $P(^ECT(731.7,YRPP,1,0),"^",2)="731.701PA"
S RESP="" F SRV=0:0 S SRV=$O(^ECC(730,"ALS",SRV)) Q:'SRV!(RESP="^") S SRVNM=$P(^ECC(730,SRV,0),"^") D LOOP
EXIT K %,%DT,%X,%Y,C,CHS,CNT,D,DA,DIC,DIE,DIK,DIR,DLAYGO,DR,DTOUT,DUOUT,I,J,PP,RESP,SRV,SRVNM,X,Y,YR,YRPP
Q
;
EDIT I '$O(^ECT(731.7,0)) W *7,!!,"File contains NO pay period data." Q
W ! S DIC="^ECT(731.7,",DIC(0)="QEAM",DIC("A")="Select CODE for Pay Period: " D ^DIC Q:Y<0 S DA=+Y K DIC
DIE S DIE="^ECT(731.7,",DR="1:10" D ^DIE K DIE
Q
;
DIK I '$O(^ECT(731.7,0)) W *7,!!,"File contains NO pay period data." Q
W ! S (DIC,DIK)="^ECT(731.7,",DIC(0)="QEAM",DIC("A")="Select CODE for Pay Period to DELETE: " D ^DIC K DIC Q:Y<0 S DA=+Y
S DIR(0)="Y",DIR("A")="Are you SURE you want to DELETE",DIR("B")="NO",DIR("?")="Enter 'Y' to delete the entry, 'N' or <RETURN> to exit." D ^DIR
Q:$D(DTOUT)!$D(DUOUT) I Y=1 D ^DIK K DIK
Q
;
LOOP S (DIC,DIE)="^ECT(731.7,"_YRPP_",1,",DIC(0)="LM",X=SRVNM,DA(1)=YRPP D ^DIC K DIC S DA=+Y W !!,"Service: ",SRVNM,! S DR="1;2;3T" D ^DIE K DIE I $D(Y) S RESP="^"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTPP 2897 printed Nov 22, 2024@17:12:52 Page 2
ECTPP ;B'ham ISC/PTD-Enter/Edit Staffing Data for Pay Period ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
+1 IF '$ORDER(^ECC(730,"ALS",0))
WRITE *7,!!?29,"OPTION IS UNAVAILABLE!",!,"Local services have not been identified!",!,"Use the 'Identify Station's Services' option.",!!
SET XQUIT=""
QUIT
+2 SET CNT=-1
FOR J=0:0
SET J=$ORDER(^ECC(730,"ALS",J))
SET CNT=CNT+1
if 'J
QUIT
+3 IF CNT<8
WRITE *7,!!?25,"WARNING",!,"You have only ",CNT," services defined for your station!",!,"Use the 'Identify Station's Services' option to verify before you continue."
+4 ;
CHS WRITE !!,"At this time, you may:",!!,"1. Enter data for a new pay period",!,"2. Edit existing data for a previously entered pay period",!,"3. Delete a pay period entered in error",!!,"Choose a number (1 - 3): "
+1 READ CHS:DTIME
if '$TEST!("^"[CHS)
GOTO EXIT
IF CHS'?1N!(CHS<1)!(CHS>3)
WRITE !!,*7,"You MUST answer with a number between 1 and 3."
GOTO CHS
+2 ;BRANCH BASED ON ENTER/EDIT CHOICE
+3 IF CHS=2
DO EDIT
GOTO EXIT
+4 IF CHS=3
DO DIK
GOTO EXIT
ENTER ;IF CHOICE 1 WAS SELECTED, CREATE NEW ENTRY WITH ASSOCIATED SERVICES
PP READ !!,"Enter Pay Period: ",PP:DTIME
if '$TEST!("^"[PP)
GOTO EXIT
IF (PP'?.N)!(PP<1)!(PP>27)
WRITE !!,*7,"You MUST answer with a number between 1 and 27."
GOTO PP
+1 if $LENGTH(PP)=1
SET PP="0"_PP
YR WRITE !
SET %DT="AE"
SET %DT("A")="Enter calendar year associated with this pay period: "
SET %DT(0)=2000000
DO ^%DT
if $DATA(DTOUT)!("^"[X)
GOTO EXIT
SET YR=$EXTRACT(Y,1,3)
SET YRPP=YR_PP
+1 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Is this correct ==> Year: "_(1700+YR)_" Pay Period: "_PP
SET DIR("B")="YES"
SET DIR("?")="Enter 'Y' if this is correct, 'N' or <RETURN> to exit."
DO ^DIR
+2 if $DATA(DTOUT)!$DATA(DUOUT)!(Y=0)
GOTO EXIT
+3 IF $DATA(^ECT(731.7,YRPP))
SET DA=YRPP
WRITE !!,"This is an EXISTING entry. You may edit if you wish.",!!
DO DIE
GOTO EXIT
DIC SET (DIC,DIE)="^ECT(731.7,"
SET DIC(0)="LM"
SET X=YRPP
SET DLAYGO=731.7
DO ^DIC
KILL DIC
if Y<0
GOTO EXIT
SET DA=+Y
SET DR="1"
DO ^DIE
KILL DIE
+1 IF '$DATA(^ECT(731.7,YRPP,1,0))
SET $PIECE(^ECT(731.7,YRPP,1,0),"^",2)="731.701PA"
+2 SET RESP=""
FOR SRV=0:0
SET SRV=$ORDER(^ECC(730,"ALS",SRV))
if 'SRV!(RESP="^")
QUIT
SET SRVNM=$PIECE(^ECC(730,SRV,0),"^")
DO LOOP
EXIT KILL %,%DT,%X,%Y,C,CHS,CNT,D,DA,DIC,DIE,DIK,DIR,DLAYGO,DR,DTOUT,DUOUT,I,J,PP,RESP,SRV,SRVNM,X,Y,YR,YRPP
+1 QUIT
+2 ;
EDIT IF '$ORDER(^ECT(731.7,0))
WRITE *7,!!,"File contains NO pay period data."
QUIT
+1 WRITE !
SET DIC="^ECT(731.7,"
SET DIC(0)="QEAM"
SET DIC("A")="Select CODE for Pay Period: "
DO ^DIC
if Y<0
QUIT
SET DA=+Y
KILL DIC
DIE SET DIE="^ECT(731.7,"
SET DR="1:10"
DO ^DIE
KILL DIE
+1 QUIT
+2 ;
DIK IF '$ORDER(^ECT(731.7,0))
WRITE *7,!!,"File contains NO pay period data."
QUIT
+1 WRITE !
SET (DIC,DIK)="^ECT(731.7,"
SET DIC(0)="QEAM"
SET DIC("A")="Select CODE for Pay Period to DELETE: "
DO ^DIC
KILL DIC
if Y<0
QUIT
SET DA=+Y
+2 SET DIR(0)="Y"
SET DIR("A")="Are you SURE you want to DELETE"
SET DIR("B")="NO"
SET DIR("?")="Enter 'Y' to delete the entry, 'N' or <RETURN> to exit."
DO ^DIR
+3 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
IF Y=1
DO ^DIK
KILL DIK
+4 QUIT
+5 ;
LOOP SET (DIC,DIE)="^ECT(731.7,"_YRPP_",1,"
SET DIC(0)="LM"
SET X=SRVNM
SET DA(1)=YRPP
DO ^DIC
KILL DIC
SET DA=+Y
WRITE !!,"Service: ",SRVNM,!
SET DR="1;2;3T"
DO ^DIE
KILL DIE
IF $DATA(Y)
SET RESP="^"
+1 QUIT
+2 ;
