- 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 Jan 18, 2025@03:04:07 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 ;