- 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 Feb 18, 2025@23:46:09 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
