- 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 Jan 18, 2025@03:20:27 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