ECTFCON.m

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 ---ECTFCON   944     printed  Apr 09, 2024@21:05:16                                                                                                                                                                                                      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       ;