source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURARFBU.m@ 847

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1NURARFBU ;HIRMFO/RM,MD,FT-AMIS REPORT 1106b...ENTER BUDGET FIGURES ;8/23/96 10:45
2 ;;4.0;NURSING SERVICE;**16**;Apr 25, 1997
3HSKPG ;
4 Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
5 S IOP=ION D ^%ZIS K IOP W @IOF
6 W !!,"You will be entering FTEE Ceiling Totals assigned by Management "
7 W !,"for Nursing Service Personnel Quarterly Report 10-1106b (AMIS) ",!
8EDIT ; FILE BUDGETED FTEE DATA
9 D ^NURAKILL
10 S NURX=$$SITE^VASITE(),X=$P(NURX,U,2),DIC="^NURSA(213.2,",DIC(0)="MZ"
11 I $$EN8^NURSAFU0()="Y"!(X="")!'($O(^NURSA(213.2,0))) S DIC("A")="Select FACILITY: ",DIC(0)="ALEMQZ",DLAYGO=213.2 K X
12 D ^DIC K DIC
13 I +Y'>0!$D(DUOUT)!($D(DTOUT)) D ^NURAKILL Q
14 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
15 I $G(^NURSA(213.2,NURDA,0))="" D UNLOCK G EDIT
16 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
17 W !!,"Date displayed is date of last budget entries."
18 W !,"Enter date of current budget entries.",!
19 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
20 S NURSCRDT=+Y
21RR D:X'="" READDATA I NUROUT D UNLOCK1,UNLOCK,^NURAKILL Q
22 D G RR:NURNOBAL,Q0
23 . S NURNOBAL=0,NURBDCK=NURSFT(1),NURBDCK1=0,X=0
24 . F NURI=1:1:15 S NURBDCK1=NURBDCK1+NURSFT(NURI+5)
25 . I NURBDCK'=NURBDCK1 D
26 ..W *7,!!,"The number of RN'S BUDGETED must equal the sum of categories",!,"06 thru 20 (e.g. Clin Specialist, Nurse Practitioner, etc.)",!!
27 ..S NURNOBAL=1
28 ..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"
29 ..D ^DIR K DIR Q:$D(DIRUT)
30 ..I Y=0 W !!,"Since categories 06 thru 20 must equal the sum of category 01,",!,"please correct the data now.",!! Q
31 ..S (NURBDCK,NURSFT(1))=NURBDCK1,NURNOBAL=0
32 ..Q
33 . Q
34Q0 W ! S DA=NURDA,DR="[NURA-I-A1106B]",DIE="^NURSA(213.2," D ^DIE
35 D UNLOCK1,UNLOCK G:$$EN8^NURSAFU0()="Y" EDIT
36 Q
37UNLOCK1 L -^NURSA(213.2,NURDA,1)
38 Q
39UNLOCK L -^NURSA(213.2,NURDA)
40 Q
41READDATA ;
42 S NUROUT=0 F NURSX=1:1:20 D READ Q:NUROUT
43 Q
44READ ;
45 S NURDFLT=0 D FIELD^DID(213.2,NURSX,"","LABEL","NX") W !,NX("LABEL"),": "
46 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
47 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
48 R NURSFT:DTIME I '$T S NUROUT=1 Q
49 I NURSFT["^" W !,*7,"SORRY NO ""^"" ALLOWED" G READ
50 S X=NURSFT
51 I NURSX'>16,NURDFLT&(NURSFT="") S NURSFT=$S('$D(NURSFT(NURSX))#2:$P(^NURSA(213.2,NURDA,0),"^",NURSX+1),1:NURSFT(NURSX))
52 I NURSX>16,NURDFLT&(NURSFT="") S NURSFT=$S('$D(NURSFT(NURSX))#2:$P(^NURSA(213.2,NURDA,.5),"^",(NURSX-16)),1:NURSFT(NURSX))
53 I $S('$D(X)#2:1,X?1"?".E:1,1:0) D G READ
54 . 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)
55 . Q
56 S NURSFT(NURSX)=NURSFT
57 Q
Note: See TracBrowser for help on using the repository browser.