- NURAED7 ;HIRMFO/MD-DATA STOREGE TMP FOR THE POSITION EDIT CONTINUED ;1/15/96
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EDVD ; EDIT VACANCY DATE
- S Y=$P(NURSOPOS,"^",8) D:Y D^DIQ S NURSDFLT=Y
- W !,"VACANCY DATE: "_$S(NURSDFLT'="":NURSDFLT_"// ",1:"") R X:DTIME S:'$T X="^^" I X="^^"!(X="^") S NUROUT=1 Q
- I X="" S:NURSDFLT'="" $P(NURSNPOS,"^",8)=$P(NURSOPOS,"^",8) G DVR
- DVD I NURLS="P",X="@",NURSDFLT'="" W !!,?3,$C(7),"PAST ASSIGNMENTS CANNOT BE RE-ACTIVATED FROM THIS SCREEN A NEW ASSIGNMENT",!,?3,"MUST BE ADDED FROM THE CURRENT SCREEN." S NUROUT=1 Q
- 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,"^",8)="" W:%=2 $C(7)," ??" G EDVR:%=1,EDVD:%=2 W !?5,$C(7),"ANSWER YES OR NO" G DVD
- I X="@" W $C(7)," ??" G EDVD
- I X?1"?".E W !?5,$C(7),"Vacancy date for this position.",!
- S %DT="E" D ^%DT G:+Y'>0 EDVD I +Y<$P(NURSNPOS,"^",3) S NURSBAD="1^3" D EN4^NURSUT3 G EDVD
- S $P(NURSNPOS,"^",8)=+Y
- EDVR ; EDIT VACANCY REASON
- G:$P(NURSOPOS,U,10)=""&'$P(NURSNPOS,U,8) QE
- S NURSDFLT=$S($D(^NURSF(211.9,+$P(NURSOPOS,U,10),0)):$P(^(0),U,2),1:"")
- W !,"VACANCY REASON: "_$S(NURSDFLT'="":NURSDFLT_"// ",1:"") R X:DTIME S:'$T X="^^" I X="^^"!(X=U) S NUROUT=1 Q
- I X="" S:NURSDFLT'="" $P(NURSNPOS,U,10)=$P(NURSOPOS,U,10) G EDTT
- DVR 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,U,10)="" W:%=2 $C(7)," ??" G EDTT:%=1,EDVR:%=2 W !?5,$C(7),"ANSWER YES OR NO" G DVR
- I X?1"?".E W !?5,$C(7),"Reason why position is vacant or why employee transferred.",!
- S DIC="^NURSF(211.9,",DLAYGO=211.9,DIC(0)="ELQM" D ^DIC I $D(DTOUT)!$D(DUOUT) S NUROUT=1 Q
- G:+Y'>0 EDVR S $P(NURSNPOS,U,10)=+Y
- EDTT ; EDIT TRANSFER TO
- G:$P(NURSOPOS,U,9)=""&($P(NURSNPOS,U,10)'=$O(^NURSF(211.9,"B","TRA",0))) QE
- S NURSDFLT=$P(NURSOPOS,U,9)
- W !,"TRANSFER TO: "_$S(NURSDFLT'="":NURSDFLT_"// ",1:"") R X:DTIME S:'$T X="^^" I X="^^"!(X=U) S NUROUT=1 Q
- I X="" S:NURSDFLT'="" $P(NURSNPOS,U,9)=$P(NURSOPOS,U,9) G QE
- DTT 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,U,10)="" W:%=2 $C(7)," ??" G QE:%=1,EDTT:%=2 W !?5,$C(7),"ANSWER YES OR NO" G DTT
- I X="@" W $C(7)," ??" G EDTT
- I $L(X)>30!($L(X)<2)!(X?1"?".E) W !?5,$C(7),"The name of the location/service (if not nursing) where this employee was",!?5,"temporarily transferred.",!!?5,"Answer must be 3-30 characters in length." G EDTT
- S $P(NURSNPOS,U,9)=X
- QE S $P(NURSNPOS,U,4)=$P(NURSOPOS,U,4) K NURSDFLT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAED7 2563 printed Feb 18, 2025@23:45:44 Page 2
- NURAED7 ;HIRMFO/MD-DATA STOREGE TMP FOR THE POSITION EDIT CONTINUED ;1/15/96
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EDVD ; EDIT VACANCY DATE
- +1 SET Y=$PIECE(NURSOPOS,"^",8)
- if Y
- DO D^DIQ
- SET NURSDFLT=Y
- +2 WRITE !,"VACANCY DATE: "_$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,"^",8)=$PIECE(NURSOPOS,"^",8)
- GOTO DVR
- DVD IF NURLS="P"
- IF X="@"
- IF NURSDFLT'=""
- WRITE !!,?3,$CHAR(7),"PAST ASSIGNMENTS CANNOT BE RE-ACTIVATED FROM THIS SCREEN A NEW ASSIGNMENT",!,?3,"MUST BE ADDED FROM THE CURRENT SCREEN."
- SET NUROUT=1
- QUIT
- +1 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,"^",8)=""
- if %=2
- WRITE $CHAR(7)," ??"
- if %=1
- GOTO EDVR
- if %=2
- GOTO EDVD
- WRITE !?5,$CHAR(7),"ANSWER YES OR NO"
- GOTO DVD
- +2 IF X="@"
- WRITE $CHAR(7)," ??"
- GOTO EDVD
- +3 IF X?1"?".E
- WRITE !?5,$CHAR(7),"Vacancy date for this position.",!
- +4 SET %DT="E"
- DO ^%DT
- if +Y'>0
- GOTO EDVD
- IF +Y<$PIECE(NURSNPOS,"^",3)
- SET NURSBAD="1^3"
- DO EN4^NURSUT3
- GOTO EDVD
- +5 SET $PIECE(NURSNPOS,"^",8)=+Y
- EDVR ; EDIT VACANCY REASON
- +1 if $PIECE(NURSOPOS,U,10)=""&'$PIECE(NURSNPOS,U,8)
- GOTO QE
- +2 SET NURSDFLT=$SELECT($DATA(^NURSF(211.9,+$PIECE(NURSOPOS,U,10),0)):$PIECE(^(0),U,2),1:"")
- +3 WRITE !,"VACANCY REASON: "_$SELECT(NURSDFLT'="":NURSDFLT_"// ",1:"")
- READ X:DTIME
- if '$TEST
- SET X="^^"
- IF X="^^"!(X=U)
- SET NUROUT=1
- QUIT
- +4 IF X=""
- if NURSDFLT'=""
- SET $PIECE(NURSNPOS,U,10)=$PIECE(NURSOPOS,U,10)
- GOTO EDTT
- DVR 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,U,10)=""
- if %=2
- WRITE $CHAR(7)," ??"
- if %=1
- GOTO EDTT
- if %=2
- GOTO EDVR
- WRITE !?5,$CHAR(7),"ANSWER YES OR NO"
- GOTO DVR
- +1 IF X?1"?".E
- WRITE !?5,$CHAR(7),"Reason why position is vacant or why employee transferred.",!
- +2 SET DIC="^NURSF(211.9,"
- SET DLAYGO=211.9
- SET DIC(0)="ELQM"
- DO ^DIC
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET NUROUT=1
- QUIT
- +3 if +Y'>0
- GOTO EDVR
- SET $PIECE(NURSNPOS,U,10)=+Y
- EDTT ; EDIT TRANSFER TO
- +1 if $PIECE(NURSOPOS,U,9)=""&($PIECE(NURSNPOS,U,10)'=$ORDER(^NURSF(211.9,"B","TRA",0)))
- GOTO QE
- +2 SET NURSDFLT=$PIECE(NURSOPOS,U,9)
- +3 WRITE !,"TRANSFER TO: "_$SELECT(NURSDFLT'="":NURSDFLT_"// ",1:"")
- READ X:DTIME
- if '$TEST
- SET X="^^"
- IF X="^^"!(X=U)
- SET NUROUT=1
- QUIT
- +4 IF X=""
- if NURSDFLT'=""
- SET $PIECE(NURSNPOS,U,9)=$PIECE(NURSOPOS,U,9)
- GOTO QE
- DTT 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,U,10)=""
- if %=2
- WRITE $CHAR(7)," ??"
- if %=1
- GOTO QE
- if %=2
- GOTO EDTT
- WRITE !?5,$CHAR(7),"ANSWER YES OR NO"
- GOTO DTT
- +1 IF X="@"
- WRITE $CHAR(7)," ??"
- GOTO EDTT
- +2 IF $LENGTH(X)>30!($LENGTH(X)<2)!(X?1"?".E)
- WRITE !?5,$CHAR(7),"The name of the location/service (if not nursing) where this employee was",!?5,"temporarily transferred.",!!?5,"Answer must be 3-30 characters in length."
- GOTO EDTT
- +3 SET $PIECE(NURSNPOS,U,9)=X
- QE SET $PIECE(NURSNPOS,U,4)=$PIECE(NURSOPOS,U,4)
- KILL NURSDFLT
- +1 QUIT
