source: WorldVistAEHR/trunk/r/INTERIM_MANAGEMENT_SUPPORT-ECT/ECTSIN1.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1ECTSIN1 ;B'ham ISC/PTD-Enter/Edit Workload Data for Fiscal Year - CONTINUED ;01/29/91 08:00
2V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
3 ;IF YRDA EXISTS, GO TO DATA INPUT
4 I $D(^ECT(731,YRDA)) G WKLD
5 ;ELSE ENTRY DOES NOT EXIST, SO ADD IT
6 S DIC="^ECT(731,",DIC(0)="LM",X=YR,DLAYGO=731 D ^DIC K DIC G:Y<0 EXIT S YRDA=+Y
7WKLD ;ENTER INPATIENT WORKLOAD DATA
8 I '$D(^ECT(731,YRDA,30,0)) S $P(^ECT(731,YRDA,30,0),"^",2)="731.03A"
9 S (LCN,RESP)="" F J=0:0 S LCN=$O(INP(LCN)) Q:LCN=""!(RESP="^") S DIV=$P(INP(LCN),"^") D LOOP1
10 ;ENTER OUTPATIENT WORKLOAD DATA
11 I '$D(^ECT(731,YRDA,40,0)) S $P(^ECT(731,YRDA,40,0),"^",2)="731.04PA"
12 S (LCN,RESP)="" F J=0:0 S LCN=$O(OPT(LCN)) Q:LCN=""!(RESP="^") D LOOP2
13EXIT 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
14 Q
15 ;
16LOOP1 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="^"
17 Q
18 ;
19LOOP2 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="^"
20 Q
21 ;
Note: See TracBrowser for help on using the repository browser.