source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURARFBU.m@ 1396

NURARFBU ;HIRMFO/RM,MD,FT-AMIS REPORT 1106b...ENTER BUDGET FIGURES ;8/23/96  10:45
 ;;4.0;NURSING SERVICE;**16**;Apr 25, 1997
HSKPG ;
 Q:'$D(^DIC(213.9,1,"OFF"))  Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
 S IOP=ION D ^%ZIS K IOP W @IOF
 W !!,"You will be entering FTEE Ceiling Totals assigned by Management "
 W !,"for Nursing Service Personnel Quarterly Report 10-1106b (AMIS) ",!
EDIT ; FILE BUDGETED FTEE DATA
 D ^NURAKILL
 S NURX=$$SITE^VASITE(),X=$P(NURX,U,2),DIC="^NURSA(213.2,",DIC(0)="MZ"
 I $$EN8^NURSAFU0()="Y"!(X="")!'($O(^NURSA(213.2,0))) S DIC("A")="Select FACILITY: ",DIC(0)="ALEMQZ",DLAYGO=213.2 K X
 D ^DIC K DIC
 I +Y'>0!$D(DUOUT)!($D(DTOUT)) D ^NURAKILL Q
 S NURDA=+Y,NURSFT("FAC")=Y(0,0) L:+NURDA>0 +^NURSA(213.2,NURDA):0 I +NURDA>0,'$T W !,"SORRY, CANNOT EDIT "_NURSFT("FAC")_" AT THIS TIME, TRY LATER." D UNLOCK G:$$EN8^NURSAFU0()="Y" EDIT D ^NURAKILL Q
 I $G(^NURSA(213.2,NURDA,0))="" D UNLOCK G EDIT
 L +^NURSA(213.2,NURDA,1):0 I '$T W !,"SORRY, CANNOT EDIT "_NURSFT("FAC")_" AT THIS TIME, TRY LATER." D UNLOCK G:$$EN8^NURSAFU0()="Y" EDIT D ^NURAKILL Q
 W !!,"Date displayed is date of last budget entries."
 W !,"Enter date of current budget entries.",!
 S:'$D(^NURSA(213.2,NURDA,1)) $P(^(1),U,11)=DT S X=+$P(^NURSA(213.2,NURDA,1),U,11),%DT="" D ^%DT G:'+Y UNLOCK D D^DIQ S %DT="AEQ",%DT("B")=Y D ^%DT I X="^" D UNLOCK1,UNLOCK,^NURAKILL Q
 S NURSCRDT=+Y
RR D:X'="" READDATA I NUROUT D UNLOCK1,UNLOCK,^NURAKILL Q
 D  G RR:NURNOBAL,Q0
 .  S NURNOBAL=0,NURBDCK=NURSFT(1),NURBDCK1=0,X=0
 .  F NURI=1:1:15 S NURBDCK1=NURBDCK1+NURSFT(NURI+5)
 .  I NURBDCK'=NURBDCK1 D
 ..W *7,!!,"The number of RN'S BUDGETED must equal the sum of categories",!,"06 thru 20 (e.g. Clin Specialist, Nurse Practitioner, etc.)",!!
 ..S NURNOBAL=1
 ..K DIR S DIR(0)="Y",DIR("A",1)="Want the computer to enter the total FTEE ("_NURBDCK1_") for categories",DIR("A")="06 thru 20 into the Budgeted RN (01) field",DIR("B")="YES"
 ..D ^DIR K DIR Q:$D(DIRUT)
 ..I Y=0 W !!,"Since categories 06 thru 20 must equal the sum of category 01,",!,"please correct the data now.",!! Q
 ..S (NURBDCK,NURSFT(1))=NURBDCK1,NURNOBAL=0
 ..Q
 .  Q
Q0 W ! S DA=NURDA,DR="[NURA-I-A1106B]",DIE="^NURSA(213.2," D ^DIE
 D UNLOCK1,UNLOCK G:$$EN8^NURSAFU0()="Y" EDIT
 Q
UNLOCK1 L -^NURSA(213.2,NURDA,1)
 Q
UNLOCK L -^NURSA(213.2,NURDA)
 Q
READDATA ;
 S NUROUT=0 F NURSX=1:1:20 D READ Q:NUROUT
 Q
READ ;
 S NURDFLT=0 D FIELD^DID(213.2,NURSX,"","LABEL","NX") W !,NX("LABEL"),": "
 I NURSX'>16,$S($D(NURSFT(NURSX))#2:1,'$D(^NURSA(213.2,NURDA)):0,$P(^NURSA(213.2,NURDA,0),"^",NURSX+1)'="":1,1:0) W $S('$D(NURSFT(NURSX))#2:$P(^NURSA(213.2,NURDA,0),"^",NURSX+1),1:NURSFT(NURSX)),"// " S NURDFLT=1
 I NURSX>16,$S($D(NURSFT(NURSX))#2:1,'$D(^NURSA(213.2,NURDA,.5)):0,$P(^NURSA(213.2,NURDA,.5),"^",(NURSX-16))'="":1,1:0) W $S('$D(NURSFT(NURSX))#2:$P(^NURSA(213.2,NURDA,.5),"^",(NURSX-16)),1:NURSFT(NURSX)),"// " S NURDFLT=1
 R NURSFT:DTIME I '$T S NUROUT=1 Q
 I NURSFT["^" W !,*7,"SORRY NO ""^"" ALLOWED" G READ
 S X=NURSFT
 I NURSX'>16,NURDFLT&(NURSFT="") S NURSFT=$S('$D(NURSFT(NURSX))#2:$P(^NURSA(213.2,NURDA,0),"^",NURSX+1),1:NURSFT(NURSX))
 I NURSX>16,NURDFLT&(NURSFT="") S NURSFT=$S('$D(NURSFT(NURSX))#2:$P(^NURSA(213.2,NURDA,.5),"^",(NURSX-16)),1:NURSFT(NURSX))
 I $S('$D(X)#2:1,X?1"?".E:1,1:0) D  G READ
 .  N NURHLP D HELP^DIE(213.2,",NURDA,",NURSX,"A","NURHLP") I $D(NURHLP("DIHELP")) F Y=1:1:NURHLP("DIHELP") W !,NURHLP("DIHELP",Y)
 .  Q
 S NURSFT(NURSX)=NURSFT
 Q