ECTFCON ;B'ham ISC/PTD-Enter/Edit Contract Data for Fiscal Year ;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
;
YR W ! S %DT="AE",%DT("A")="Enter two digit code for Fiscal Year: ",%DT(0)=2700000 D ^%DT G:$D(DTOUT)!("^"[X) EXIT S YRDA=$E(Y,1,3),YR=$E(Y,2,3)
I $D(^ECT(731,YRDA)) G CONTR
DIC S DIC="^ECT(731,",DIC(0)="LM",X=YR,DLAYGO=731 D ^DIC K DIC G:Y<0 EXIT S YRDA=+Y
CONTR I '$D(^ECT(731,YRDA,20,0)) S $P(^ECT(731,YRDA,20,0),"^",2)="731.02A"
W ! S (DIC,DIE)="^ECT(731,"_YRDA_",20,",DIC(0)="QEALM",DA(1)=YRDA,DIC("A")="Enter CONTRACT number: ",DIC("W")="I $P(^ECT(731,YRDA,20,Y,0),U,2)'="""" W "" "",$P(^(0),U,2)" D ^DIC K DIC G:Y<0 EXIT S DA=+Y
S DR=".01:5" D ^DIE K DIE G CONTR
EXIT K %,%DT,%Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,X,Y,YR,YRDA
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTFCON 944 printed Dec 13, 2024@02:02:23 Page 2
ECTFCON ;B'ham ISC/PTD-Enter/Edit Contract Data for Fiscal Year ;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 ;
YR WRITE !
SET %DT="AE"
SET %DT("A")="Enter two digit code for Fiscal Year: "
SET %DT(0)=2700000
DO ^%DT
if $DATA(DTOUT)!("^"[X)
GOTO EXIT
SET YRDA=$EXTRACT(Y,1,3)
SET YR=$EXTRACT(Y,2,3)
+1 IF $DATA(^ECT(731,YRDA))
GOTO CONTR
DIC SET DIC="^ECT(731,"
SET DIC(0)="LM"
SET X=YR
SET DLAYGO=731
DO ^DIC
KILL DIC
if Y<0
GOTO EXIT
SET YRDA=+Y
CONTR IF '$DATA(^ECT(731,YRDA,20,0))
SET $PIECE(^ECT(731,YRDA,20,0),"^",2)="731.02A"
+1 WRITE !
SET (DIC,DIE)="^ECT(731,"_YRDA_",20,"
SET DIC(0)="QEALM"
SET DA(1)=YRDA
SET DIC("A")="Enter CONTRACT number: "
SET DIC("W")="I $P(^ECT(731,YRDA,20,Y,0),U,2)'="""" W "" "",$P(^(0),U,2)"
DO ^DIC
KILL DIC
if Y<0
GOTO EXIT
SET DA=+Y
+2 SET DR=".01:5"
DO ^DIE
KILL DIE
GOTO CONTR
EXIT KILL %,%DT,%Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,X,Y,YR,YRDA
+1 QUIT
+2 ;
