ECTSIN1 ;B'ham ISC/PTD-Enter/Edit Workload Data for Fiscal Year - CONTINUED ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
;IF YRDA EXISTS, GO TO DATA INPUT
I $D(^ECT(731,YRDA)) G WKLD
;ELSE ENTRY DOES NOT EXIST, SO ADD IT
S DIC="^ECT(731,",DIC(0)="LM",X=YR,DLAYGO=731 D ^DIC K DIC G:Y<0 EXIT S YRDA=+Y
WKLD ;ENTER INPATIENT WORKLOAD DATA
I '$D(^ECT(731,YRDA,30,0)) S $P(^ECT(731,YRDA,30,0),"^",2)="731.03A"
S (LCN,RESP)="" F J=0:0 S LCN=$O(INP(LCN)) Q:LCN=""!(RESP="^") S DIV=$P(INP(LCN),"^") D LOOP1
;ENTER OUTPATIENT WORKLOAD DATA
I '$D(^ECT(731,YRDA,40,0)) S $P(^ECT(731,YRDA,40,0),"^",2)="731.04PA"
S (LCN,RESP)="" F J=0:0 S LCN=$O(OPT(LCN)) Q:LCN=""!(RESP="^") D LOOP2
EXIT K %,%DT,%X,%Y,ANS,ARR,C,CNT,DA,DIC,DIE,DIR,DIRUT,DIV,DLAYGO,DR,DTOUT,DUOUT,FY,INP,INPREF,I,J,LCN,LOC,OP,OPT,OPTREF,RESP,SRV,VAR,WD,X,Y,YEAR,YR,YRDA
Q
;
LOOP1 S (DIC,DIE)="^ECT(731,"_YRDA_",30,",DIC(0)="LM",X=LCN,DA(1)=YRDA D ^DIC K DIC S DA=+Y W !!,"==> Inpatient location: ",LCN S DR="1///^S X=DIV;2" D ^DIE K DIE I $D(Y) S RESP="^"
Q
;
LOOP2 S (DIC,DIE)="^ECT(731,"_YRDA_",40,",DIC(0)="LM",X=LCN,DA(1)=YRDA D ^DIC K DIC S DA=+Y W !!,"==> Outpatient location: ",LCN S DR="1" D ^DIE K DIE I $D(Y) S RESP="^"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTSIN1 1237 printed Dec 13, 2024@02:02:55 Page 2
ECTSIN1 ;B'ham ISC/PTD-Enter/Edit Workload Data for Fiscal Year - CONTINUED ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
+1 ;IF YRDA EXISTS, GO TO DATA INPUT
+2 IF $DATA(^ECT(731,YRDA))
GOTO WKLD
+3 ;ELSE ENTRY DOES NOT EXIST, SO ADD IT
+4 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
WKLD ;ENTER INPATIENT WORKLOAD DATA
+1 IF '$DATA(^ECT(731,YRDA,30,0))
SET $PIECE(^ECT(731,YRDA,30,0),"^",2)="731.03A"
+2 SET (LCN,RESP)=""
FOR J=0:0
SET LCN=$ORDER(INP(LCN))
if LCN=""!(RESP="^")
QUIT
SET DIV=$PIECE(INP(LCN),"^")
DO LOOP1
+3 ;ENTER OUTPATIENT WORKLOAD DATA
+4 IF '$DATA(^ECT(731,YRDA,40,0))
SET $PIECE(^ECT(731,YRDA,40,0),"^",2)="731.04PA"
+5 SET (LCN,RESP)=""
FOR J=0:0
SET LCN=$ORDER(OPT(LCN))
if LCN=""!(RESP="^")
QUIT
DO LOOP2
EXIT KILL %,%DT,%X,%Y,ANS,ARR,C,CNT,DA,DIC,DIE,DIR,DIRUT,DIV,DLAYGO,DR,DTOUT,DUOUT,FY,INP,INPREF,I,J,LCN,LOC,OP,OPT,OPTREF,RESP,SRV,VAR,WD,X,Y,YEAR,YR,YRDA
+1 QUIT
+2 ;
LOOP1 SET (DIC,DIE)="^ECT(731,"_YRDA_",30,"
SET DIC(0)="LM"
SET X=LCN
SET DA(1)=YRDA
DO ^DIC
KILL DIC
SET DA=+Y
WRITE !!,"==> Inpatient location: ",LCN
SET DR="1///^S X=DIV;2"
DO ^DIE
KILL DIE
IF $DATA(Y)
SET RESP="^"
+1 QUIT
+2 ;
LOOP2 SET (DIC,DIE)="^ECT(731,"_YRDA_",40,"
SET DIC(0)="LM"
SET X=LCN
SET DA(1)=YRDA
DO ^DIC
KILL DIC
SET DA=+Y
WRITE !!,"==> Outpatient location: ",LCN
SET DR="1"
DO ^DIE
KILL DIE
IF $DATA(Y)
SET RESP="^"
+1 QUIT
+2 ;
