Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECTSIN1

ECTSIN1.m

Go to the documentation of this file.
  1. ECTSIN1 ;B'ham ISC/PTD-Enter/Edit Workload Data for Fiscal Year - CONTINUED ;01/29/91 08:00
  1. V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
  1. ;IF YRDA EXISTS, GO TO DATA INPUT
  1. I $D(^ECT(731,YRDA)) G WKLD
  1. ;ELSE ENTRY DOES NOT EXIST, SO ADD IT
  1. S DIC="^ECT(731,",DIC(0)="LM",X=YR,DLAYGO=731 D ^DIC K DIC G:Y<0 EXIT S YRDA=+Y
  1. WKLD ;ENTER INPATIENT WORKLOAD DATA
  1. I '$D(^ECT(731,YRDA,30,0)) S $P(^ECT(731,YRDA,30,0),"^",2)="731.03A"
  1. S (LCN,RESP)="" F J=0:0 S LCN=$O(INP(LCN)) Q:LCN=""!(RESP="^") S DIV=$P(INP(LCN),"^") D LOOP1
  1. ;ENTER OUTPATIENT WORKLOAD DATA
  1. I '$D(^ECT(731,YRDA,40,0)) S $P(^ECT(731,YRDA,40,0),"^",2)="731.04PA"
  1. S (LCN,RESP)="" F J=0:0 S LCN=$O(OPT(LCN)) Q:LCN=""!(RESP="^") D LOOP2
  1. 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
  1. Q
  1. ;
  1. 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="^"
  1. Q
  1. ;
  1. 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="^"
  1. Q
  1. ;