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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURARFBU 3481 printed Apr 09, 2024@21:24:32 Page 2
NURARFBU ;HIRMFO/RM,MD,FT-AMIS REPORT 1106b...ENTER BUDGET FIGURES ;8/23/96 10:45
+1 ;;4.0;NURSING SERVICE;**16**;Apr 25, 1997
HSKPG ;
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
QUIT
+2 SET IOP=ION
DO ^%ZIS
KILL IOP
WRITE @IOF
+3 WRITE !!,"You will be entering FTEE Ceiling Totals assigned by Management "
+4 WRITE !,"for Nursing Service Personnel Quarterly Report 10-1106b (AMIS) ",!
EDIT ; FILE BUDGETED FTEE DATA
+1 DO ^NURAKILL
+2 SET NURX=$$SITE^VASITE()
SET X=$PIECE(NURX,U,2)
SET DIC="^NURSA(213.2,"
SET DIC(0)="MZ"
+3 IF $$EN8^NURSAFU0()="Y"!(X="")!'($ORDER(^NURSA(213.2,0)))
SET DIC("A")="Select FACILITY: "
SET DIC(0)="ALEMQZ"
SET DLAYGO=213.2
KILL X
+4 DO ^DIC
KILL DIC
+5 IF +Y'>0!$DATA(DUOUT)!($DATA(DTOUT))
DO ^NURAKILL
QUIT
+6 SET NURDA=+Y
SET NURSFT("FAC")=Y(0,0)
if +NURDA>0
LOCK +^NURSA(213.2,NURDA):0
IF +NURDA>0
IF '$TEST
WRITE !,"SORRY, CANNOT EDIT "_NURSFT("FAC")_" AT THIS TIME, TRY LATER."
DO UNLOCK
if $$EN8^NURSAFU0()="Y"
GOTO EDIT
DO ^NURAKILL
QUIT
+7 IF $GET(^NURSA(213.2,NURDA,0))=""
DO UNLOCK
GOTO EDIT
+8 LOCK +^NURSA(213.2,NURDA,1):0
IF '$TEST
WRITE !,"SORRY, CANNOT EDIT "_NURSFT("FAC")_" AT THIS TIME, TRY LATER."
DO UNLOCK
if $$EN8^NURSAFU0()="Y"
GOTO EDIT
DO ^NURAKILL
QUIT
+9 WRITE !!,"Date displayed is date of last budget entries."
+10 WRITE !,"Enter date of current budget entries.",!
+11 if '$DATA(^NURSA(213.2,NURDA,1))
SET $PIECE(^(1),U,11)=DT
SET X=+$PIECE(^NURSA(213.2,NURDA,1),U,11)
SET %DT=""
DO ^%DT
if '+Y
GOTO UNLOCK
DO D^DIQ
SET %DT="AEQ"
SET %DT("B")=Y
DO ^%DT
IF X="^"
DO UNLOCK1
DO UNLOCK
DO ^NURAKILL
QUIT
+12 SET NURSCRDT=+Y
RR if X'=""
DO READDATA
IF NUROUT
DO UNLOCK1
DO UNLOCK
DO ^NURAKILL
QUIT
+1 Begin DoDot:1
+2 SET NURNOBAL=0
SET NURBDCK=NURSFT(1)
SET NURBDCK1=0
SET X=0
+3 FOR NURI=1:1:15
SET NURBDCK1=NURBDCK1+NURSFT(NURI+5)
+4 IF NURBDCK'=NURBDCK1
Begin DoDot:2
+5 WRITE *7,!!,"The number of RN'S BUDGETED must equal the sum of categories",!,"06 thru 20 (e.g. Clin Specialist, Nurse Practitioner, etc.)",!!
+6 SET NURNOBAL=1
+7 KILL DIR
SET DIR(0)="Y"
SET DIR("A",1)="Want the computer to enter the total FTEE ("_NURBDCK1_") for categories"
SET DIR("A")="06 thru 20 into the Budgeted RN (01) field"
SET DIR("B")="YES"
+8 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+9 IF Y=0
WRITE !!,"Since categories 06 thru 20 must equal the sum of category 01,",!,"please correct the data now.",!!
QUIT
+10 SET (NURBDCK,NURSFT(1))=NURBDCK1
SET NURNOBAL=0
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
if NURNOBAL
GOTO RR
GOTO Q0
Q0 WRITE !
SET DA=NURDA
SET DR="[NURA-I-A1106B]"
SET DIE="^NURSA(213.2,"
DO ^DIE
+1 DO UNLOCK1
DO UNLOCK
if $$EN8^NURSAFU0()="Y"
GOTO EDIT
+2 QUIT
UNLOCK1 LOCK -^NURSA(213.2,NURDA,1)
+1 QUIT
UNLOCK LOCK -^NURSA(213.2,NURDA)
+1 QUIT
READDATA ;
+1 SET NUROUT=0
FOR NURSX=1:1:20
DO READ
if NUROUT
QUIT
+2 QUIT
READ ;
+1 SET NURDFLT=0
DO FIELD^DID(213.2,NURSX,"","LABEL","NX")
WRITE !,NX("LABEL"),": "
+2 IF NURSX'>16
IF $SELECT($DATA(NURSFT(NURSX))#2:1,'$DATA(^NURSA(213.2,NURDA)):0,$PIECE(^NURSA(213.2,NURDA,0),"^",NURSX+1)'="":1,1:0)
WRITE $SELECT('$DATA(NURSFT(NURSX))#2:$PIECE(^NURSA(213.2,NURDA,0),"^",NURSX+1),1:NURSFT(NURSX)),"// "
SET NURDFLT=1
+3 IF NURSX>16
IF $SELECT($DATA(NURSFT(NURSX))#2:1,'$DATA(^NURSA(213.2,NURDA,.5)):0,$PIECE(^NURSA(213.2,NURDA,.5),"^",(NURSX-16))'="":1,1:0)
WRITE $SELECT('$DATA(NURSFT(NURSX))#2:$PIECE(^NURSA(213.2,NURDA,.5),"^",(NURSX-16)),1:NURSFT(NURSX)),"// "
SET NURDFLT=1
+4 READ NURSFT:DTIME
IF '$TEST
SET NUROUT=1
QUIT
+5 IF NURSFT["^"
WRITE !,*7,"SORRY NO ""^"" ALLOWED"
GOTO READ
+6 SET X=NURSFT
+7 IF NURSX'>16
IF NURDFLT&(NURSFT="")
SET NURSFT=$SELECT('$DATA(NURSFT(NURSX))#2:$PIECE(^NURSA(213.2,NURDA,0),"^",NURSX+1),1:NURSFT(NURSX))
+8 IF NURSX>16
IF NURDFLT&(NURSFT="")
SET NURSFT=$SELECT('$DATA(NURSFT(NURSX))#2:$PIECE(^NURSA(213.2,NURDA,.5),"^",(NURSX-16)),1:NURSFT(NURSX))
+9 IF $SELECT('$DATA(X)#2:1,X?1"?".E:1,1:0)
Begin DoDot:1
+10 NEW NURHLP
DO HELP^DIE(213.2,",NURDA,",NURSX,"A","NURHLP")
IF $DATA(NURHLP("DIHELP"))
FOR Y=1:1:NURHLP("DIHELP")
WRITE !,NURHLP("DIHELP",Y)
+11 QUIT
End DoDot:1
GOTO READ
+12 SET NURSFT(NURSX)=NURSFT
+13 QUIT
