NURAED5 ;HIRMFO/MD-PROCESS POSITION MODIFICATIONS 12/8/98
;;4.0;NURSING SERVICE;**22,24,28**;Apr 25, 1997
EDTFLD ; SETS THE NURSNPOS = LOC^SCAT^(9 PIECES OF ZEROTH NODE)
; DEFAULT VALUES STORED IN NURSOPOS
K NURSNPOS
EDPRI ; EDIT PRIMARY ASSIGNMENT FLAG
S NURSDFLT=$S($P(NURSOPOS,"^",11):1,1:2)
W !,"Is this a primary assignment" S %=NURSDFLT D YN^DICN I %=-1 S NUROUT=1 Q
I '% W !?5,$C(7),"ANSWER YES IF THIS POSITION IS A PRIMARY ASSIGNMENT FOR THIS EMPLOYEE,",!?5,"ELSE ANSWER NO." G EDPRI
S $P(NURSNPOS,"^",11)=$S(%=1:1,1:"")
EDLO ; EDIT LOCATION
S NPWARD=$P(NURSOPOS,"^") D EN7^NURSAUTL S NURSDFLT=NPWARD W !,"LOCATION: "_$S(NURSDFLT'="":NURSDFLT_"// ",1:"") R X:DTIME S:'$T X="^^" I X="^^"!(X="^") S NUROUT=1 Q
I X=""!(X="@") S:NURSDFLT'=""&(X="") $P(NURSNPOS,"^")=$P(NURSOPOS,"^") W:NURSDFLT=""!(X="@") $C(7)," Required??" G EDLO:NURSDFLT=""!(X="@"),EDEVAL
I X?1"?".E W !?5,$C(7),"Nursing location for this position.",!
S DIC="^NURSF(211.4,",DIC(0)="EQZ" D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) S NUROUT=1 Q
G:+Y'>0 EDLO S $P(NURSNPOS,"^")=$P(Y,"^",2)
EDEVAL ; EDIT NAME OF DATE OF PROFICIENCY/NAME OF EVALUATOR
I $P(NURSNPOS,U,11)=1 N DIE,DIC,DA,DR,NURX,Y,X D
. S:'$D(^NURSF(210,+NURSDBA,14,0)) ^(0)="^210.18D^^" S NURX=+$P($G(^NURSF(210,+NURSDBA,14,0)),U,3) I +$G(^NURSF(210,+NURSDBA,14,NURX,0)) S Y=+^(0) D D^DIQ S DIC("B")=Y
. S DA(1)=+NURSDBA,DIC="^NURSF(210,DA(1),14,",DIC("DR")=".01//;1//",DLAYGO=210.18,DIC(0)="AELQ" D ^DIC S:$G(DUOUT) NUROUT=1 Q:+Y'>0
. I $P($G(Y),U,3)="" S DIE=DIC,DR=".01//;1//",DA=+Y D ^DIE K DIE,DIC
. S:$O(Y(""))'="" NUROUT=1
. Q
EDSP ; EDIT SERVICE POSITION, WILL STUFF IN NEW SERVICE CATEGORY
Q:NUROUT
S NURSDFLT=$S($D(^NURSF(211.3,+$P(NURSOPOS,"^",5),0)):$P(^(0),"^"),1:"")
W !,"SERVICE POSITION: "_$S(NURSDFLT'="":NURSDFLT_"// ",1:"") R X:DTIME S:'$T X="^^" I X="^^"!(X="^") S NUROUT=1 Q
I X=""!(X="@") S:NURSDFLT'=""&(X="") $P(NURSNPOS,"^",5)=$P(NURSOPOS,"^",5),$P(NURSNPOS,"^",2)=$P(NURSOPOS,"^",2) W:NURSDFLT=""!(X="@") $C(7)," Required??" G EDSP:NURSDFLT=""!(X="@"),EDST
I X?1"?".E W !?5,$C(7),"Service position for this position.",!
S DIC="^NURSF(211.3,",DIC(0)="EQZ" D ^DIC I $D(DTOUT)!$D(DUOUT) S NUROUT=1 Q
G:+Y'>0 EDSP S $P(NURSNPOS,"^",2)=$P(Y(0),"^",5),$P(NURSNPOS,"^",5)=+Y
EDST ; EDIT START DATE
K NBAD S Y=$P(NURSOPOS,"^",3) D:Y D^DIQ S NURSDFLT=Y
W !,"STARTING DATE: "_$S(NURSDFLT'="":NURSDFLT_"// ",1:"") R X:DTIME S:'$T X="^^" I X="^^"!(X="^") S NUROUT=1 Q
I X=""!(X="@") D SDTCK G:$D(NBAD) EDST S:NURSDFLT'=""&(X="") $P(NURSNPOS,U,3)=$P(NURSOPOS,U,3) W:NURSDFLT=""!(X="@") $C(7)," Required??" G EDST:NURSDFLT=""!(X="@"),EDTR
I X?1"?".E W !?5,$C(7),"Starting date for this position.",!
S %DT="E" D ^%DT G:+Y'>0 EDST I $P(NURSNPOS,"^",6),+Y>$P(NURSNPOS,"^",6) S NURSBAD="1^3" D EN4^NURSUT3 G EDST
S $P(NURSNPOS,"^",3)=+Y
EDTR ;EDIT TOUR OF DUTY
S NURSDFLT=$S($D(^NURSF(211.6,+$P(NURSOPOS,"^",12),0)):$P(^(0),"^"),1:"")
W !,"ASSIGN TOUR OF DUTY: "_$S(NURSDFLT'="":NURSDFLT_"// ",1:"") R X:DTIME S:'$T X="^^" I X="^^"!(X="^") S NUROUT=1 Q
I X="" S:NURSDFLT'="" $P(NURSNPOS,"^",12)=$P(NURSOPOS,"^",12) G EDFT
DTR I X="@",NURSDFLT'="" W !,?3,$C(7),"SURE YOU WANT TO DELETE" S %=0 D YN^DICN S:%=-1 NUROUT=1 Q:NUROUT S:%=1 $P(NURSNPOS,"^",12)="" W:%=2 $C(7)," ??" G EDFT:%=1,EDTR:%=2 W !?5,$C(7),"ANSWER YES OR NO" G DTR
I X?1"?".E W !?5,$C(7),"Tour of duty for this position.",!
S DIC="^NURSF(211.6,",DIC(0)="ELQM",DLAYGO=211.9 D ^DIC I $D(DTOUT)!$D(DUOUT) S NUROUT=1 Q
G:+Y'>0 EDTR S $P(NURSNPOS,"^",12)=+Y
EDFT ; EDIT FTEE
S NURSDFLT=$P(NURSOPOS,"^",6)
W !,"FTEE: "_$S(NURSDFLT'="":NURSDFLT_"// ",1:"") R X:DTIME S:'$T X="^^" I X="^^"!(X="^") S NUROUT=1 Q
I X=""!(X="@") S:NURSDFLT'=""&(X="") $P(NURSNPOS,"^",6)=$P(NURSOPOS,"^",6) W:NURSDFLT=""!(X="@") $C(7)," Required??" G EDFT:NURSDFLT=""!(X="@"),EDREST
I X'=+X!(X>1)!(X<0)!(X?.E1"."4N.N) W !?5,$C(7),"The amount of FTEE assigned to this employee for this position.",!!?5,"Type a number between 0 and 1, 3 decimal digits." G EDFT
S $P(NURSNPOS,"^",6)=X
EDREST ; EDIT REST OF DATA
D EDVD^NURAED7
Q
SDTCK ;
I $P(NURSOPOS,U,8),$P(NURSOPOS,U,3)>$P(NURSOPOS,U,8) S (NBAD,NURSBAD)="1^3" D EN4^NURSUT3
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAED5 4220 printed Nov 22, 2024@17:29:21 Page 2
NURAED5 ;HIRMFO/MD-PROCESS POSITION MODIFICATIONS 12/8/98
+1 ;;4.0;NURSING SERVICE;**22,24,28**;Apr 25, 1997
EDTFLD ; SETS THE NURSNPOS = LOC^SCAT^(9 PIECES OF ZEROTH NODE)
+1 ; DEFAULT VALUES STORED IN NURSOPOS
+2 KILL NURSNPOS
EDPRI ; EDIT PRIMARY ASSIGNMENT FLAG
+1 SET NURSDFLT=$SELECT($PIECE(NURSOPOS,"^",11):1,1:2)
+2 WRITE !,"Is this a primary assignment"
SET %=NURSDFLT
DO YN^DICN
IF %=-1
SET NUROUT=1
QUIT
+3 IF '%
WRITE !?5,$CHAR(7),"ANSWER YES IF THIS POSITION IS A PRIMARY ASSIGNMENT FOR THIS EMPLOYEE,",!?5,"ELSE ANSWER NO."
GOTO EDPRI
+4 SET $PIECE(NURSNPOS,"^",11)=$SELECT(%=1:1,1:"")
EDLO ; EDIT LOCATION
+1 SET NPWARD=$PIECE(NURSOPOS,"^")
DO EN7^NURSAUTL
SET NURSDFLT=NPWARD
WRITE !,"LOCATION: "_$SELECT(NURSDFLT'="":NURSDFLT_"// ",1:"")
READ X:DTIME
if '$TEST
SET X="^^"
IF X="^^"!(X="^")
SET NUROUT=1
QUIT
+2 IF X=""!(X="@")
if NURSDFLT'=""&(X="")
SET $PIECE(NURSNPOS,"^")=$PIECE(NURSOPOS,"^")
if NURSDFLT=""!(X="@")
WRITE $CHAR(7)," Required??"
if NURSDFLT=""!(X="@")
GOTO EDLO
GOTO EDEVAL
+3 IF X?1"?".E
WRITE !?5,$CHAR(7),"Nursing location for this position.",!
+4 SET DIC="^NURSF(211.4,"
SET DIC(0)="EQZ"
DO ^DIC
KILL DIC
IF $DATA(DTOUT)!$DATA(DUOUT)
SET NUROUT=1
QUIT
+5 if +Y'>0
GOTO EDLO
SET $PIECE(NURSNPOS,"^")=$PIECE(Y,"^",2)
EDEVAL ; EDIT NAME OF DATE OF PROFICIENCY/NAME OF EVALUATOR
+1 IF $PIECE(NURSNPOS,U,11)=1
NEW DIE,DIC,DA,DR,NURX,Y,X
Begin DoDot:1
+2 if '$DATA(^NURSF(210,+NURSDBA,14,0))
SET ^(0)="^210.18D^^"
SET NURX=+$PIECE($GET(^NURSF(210,+NURSDBA,14,0)),U,3)
IF +$GET(^NURSF(210,+NURSDBA,14,NURX,0))
SET Y=+^(0)
DO D^DIQ
SET DIC("B")=Y
+3 SET DA(1)=+NURSDBA
SET DIC="^NURSF(210,DA(1),14,"
SET DIC("DR")=".01//;1//"
SET DLAYGO=210.18
SET DIC(0)="AELQ"
DO ^DIC
if $GET(DUOUT)
SET NUROUT=1
if +Y'>0
QUIT
+4 IF $PIECE($GET(Y),U,3)=""
SET DIE=DIC
SET DR=".01//;1//"
SET DA=+Y
DO ^DIE
KILL DIE,DIC
+5 if $ORDER(Y(""))'=""
SET NUROUT=1
+6 QUIT
End DoDot:1
EDSP ; EDIT SERVICE POSITION, WILL STUFF IN NEW SERVICE CATEGORY
+1 if NUROUT
QUIT
+2 SET NURSDFLT=$SELECT($DATA(^NURSF(211.3,+$PIECE(NURSOPOS,"^",5),0)):$PIECE(^(0),"^"),1:"")
+3 WRITE !,"SERVICE POSITION: "_$SELECT(NURSDFLT'="":NURSDFLT_"// ",1:"")
READ X:DTIME
if '$TEST
SET X="^^"
IF X="^^"!(X="^")
SET NUROUT=1
QUIT
+4 IF X=""!(X="@")
if NURSDFLT'=""&(X="")
SET $PIECE(NURSNPOS,"^",5)=$PIECE(NURSOPOS,"^",5)
SET $PIECE(NURSNPOS,"^",2)=$PIECE(NURSOPOS,"^",2)
if NURSDFLT=""!(X="@")
WRITE $CHAR(7)," Required??"
if NURSDFLT=""!(X="@")
GOTO EDSP
GOTO EDST
+5 IF X?1"?".E
WRITE !?5,$CHAR(7),"Service position for this position.",!
+6 SET DIC="^NURSF(211.3,"
SET DIC(0)="EQZ"
DO ^DIC
IF $DATA(DTOUT)!$DATA(DUOUT)
SET NUROUT=1
QUIT
+7 if +Y'>0
GOTO EDSP
SET $PIECE(NURSNPOS,"^",2)=$PIECE(Y(0),"^",5)
SET $PIECE(NURSNPOS,"^",5)=+Y
EDST ; EDIT START DATE
+1 KILL NBAD
SET Y=$PIECE(NURSOPOS,"^",3)
if Y
DO D^DIQ
SET NURSDFLT=Y
+2 WRITE !,"STARTING DATE: "_$SELECT(NURSDFLT'="":NURSDFLT_"// ",1:"")
READ X:DTIME
if '$TEST
SET X="^^"
IF X="^^"!(X="^")
SET NUROUT=1
QUIT
+3 IF X=""!(X="@")
DO SDTCK
if $DATA(NBAD)
GOTO EDST
if NURSDFLT'=""&(X="")
SET $PIECE(NURSNPOS,U,3)=$PIECE(NURSOPOS,U,3)
if NURSDFLT=""!(X="@")
WRITE $CHAR(7)," Required??"
if NURSDFLT=""!(X="@")
GOTO EDST
GOTO EDTR
+4 IF X?1"?".E
WRITE !?5,$CHAR(7),"Starting date for this position.",!
+5 SET %DT="E"
DO ^%DT
if +Y'>0
GOTO EDST
IF $PIECE(NURSNPOS,"^",6)
IF +Y>$PIECE(NURSNPOS,"^",6)
SET NURSBAD="1^3"
DO EN4^NURSUT3
GOTO EDST
+6 SET $PIECE(NURSNPOS,"^",3)=+Y
EDTR ;EDIT TOUR OF DUTY
+1 SET NURSDFLT=$SELECT($DATA(^NURSF(211.6,+$PIECE(NURSOPOS,"^",12),0)):$PIECE(^(0),"^"),1:"")
+2 WRITE !,"ASSIGN TOUR OF DUTY: "_$SELECT(NURSDFLT'="":NURSDFLT_"// ",1:"")
READ X:DTIME
if '$TEST
SET X="^^"
IF X="^^"!(X="^")
SET NUROUT=1
QUIT
+3 IF X=""
if NURSDFLT'=""
SET $PIECE(NURSNPOS,"^",12)=$PIECE(NURSOPOS,"^",12)
GOTO EDFT
DTR IF X="@"
IF NURSDFLT'=""
WRITE !,?3,$CHAR(7),"SURE YOU WANT TO DELETE"
SET %=0
DO YN^DICN
if %=-1
SET NUROUT=1
if NUROUT
QUIT
if %=1
SET $PIECE(NURSNPOS,"^",12)=""
if %=2
WRITE $CHAR(7)," ??"
if %=1
GOTO EDFT
if %=2
GOTO EDTR
WRITE !?5,$CHAR(7),"ANSWER YES OR NO"
GOTO DTR
+1 IF X?1"?".E
WRITE !?5,$CHAR(7),"Tour of duty for this position.",!
+2 SET DIC="^NURSF(211.6,"
SET DIC(0)="ELQM"
SET DLAYGO=211.9
DO ^DIC
IF $DATA(DTOUT)!$DATA(DUOUT)
SET NUROUT=1
QUIT
+3 if +Y'>0
GOTO EDTR
SET $PIECE(NURSNPOS,"^",12)=+Y
EDFT ; EDIT FTEE
+1 SET NURSDFLT=$PIECE(NURSOPOS,"^",6)
+2 WRITE !,"FTEE: "_$SELECT(NURSDFLT'="":NURSDFLT_"// ",1:"")
READ X:DTIME
if '$TEST
SET X="^^"
IF X="^^"!(X="^")
SET NUROUT=1
QUIT
+3 IF X=""!(X="@")
if NURSDFLT'=""&(X="")
SET $PIECE(NURSNPOS,"^",6)=$PIECE(NURSOPOS,"^",6)
if NURSDFLT=""!(X="@")
WRITE $CHAR(7)," Required??"
if NURSDFLT=""!(X="@")
GOTO EDFT
GOTO EDREST
+4 IF X'=+X!(X>1)!(X<0)!(X?.E1"."4N.N)
WRITE !?5,$CHAR(7),"The amount of FTEE assigned to this employee for this position.",!!?5,"Type a number between 0 and 1, 3 decimal digits."
GOTO EDFT
+5 SET $PIECE(NURSNPOS,"^",6)=X
EDREST ; EDIT REST OF DATA
+1 DO EDVD^NURAED7
+2 QUIT
SDTCK ;
+1 IF $PIECE(NURSOPOS,U,8)
IF $PIECE(NURSOPOS,U,3)>$PIECE(NURSOPOS,U,8)
SET (NBAD,NURSBAD)="1^3"
DO EN4^NURSUT3
+2 QUIT
