- NURAED0 ;HIRMFO/RM,JH,FT-MODULE TO EDIT NURS STAFF FILE ;8/23/96 10:41
- ;;4.0;NURSING SERVICE;**3**;Apr 25, 1997
- EN14 ; CALL FROM OPTION NURAED-STF-MENU
- I '$D(^DIC(213.9,1,"OFF")) S XQUIT=1 Q
- I $P(^DIC(213.9,1,"OFF"),"^",1)=1 S XQUIT=1 Q
- D EN1^NURAED01
- Q
- EN13 ; CALLED BY MENU OPTION NURAED-STF-ALL
- D C I $D(NQUIT) D Q Q
- F ZX=1:1:10 D @("EN"_ZX) D:ZX<10 CONTASK Q:X=""
- K %,ZX D Q
- Q
- CONTASK ;
- S %=1 W !!,"DO YOU WISH TO CONTINUE TO THE NEXT SECTION" D YN^DICN
- I %=-1!(%=2) S X="" Q
- I %=1 S X=1 Q
- W !,"ANSWER YES OR NO" G CONTASK
- EN1 ; CALLED BY OPTION NURAED-STF-DEMO
- D C I $D(NQUIT) D Q Q
- S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2) D HEADER^NURAED1 W !,"Nursing Employee Demographic Data Edit. ",!
- I $S('$D(^DIC(213.9,1,0)):0,$P(^(0),"^",3)'=0:1,1:0) S DIE=$P(NURSDBA,"^",2),DA=+NURSDBA,DR="[NURSAED-I-STAFFPR]" D ^DIE K NURSX I X="" D Q Q
- S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF1]" D ^DIE,Q Q
- EN2 ; CALLED BY OPTION NURAED-STF-PER
- D C I $D(NQUIT) D Q Q
- S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFFPD]" D HEADER^NURAED1,^DIE,Q Q
- EN3 ; CALLED BY OPTION NURAED-STF-STA/POS
- D C I $D(NQUIT) D Q Q
- S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2) D HEADER^NURAED1 W !,"Employee's Status and Position.",! S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR=5.5 D ^DIE I X="" D Q Q
- D ^NURAED1 I '$G(NUROUT) W !! S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF2]" D ^DIE
- D Q K NUROUT Q
- EN4 ; CALLED BY OPTION NURAED-STF-LIC
- D C I $D(NQUIT) D Q Q
- S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF3]" D HEADER^NURAED1,^DIE,Q Q
- EN5 ; CALLED BY OPTION NURAED-STF-PROB
- D C I $D(NQUIT) D Q Q
- S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF10]" D HEADER^NURAED1,^DIE,Q Q
- EN6 ; CALLED BY OPTION NURAED-STF-NPSB
- D C I $D(NQUIT) D Q Q
- S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF11]" D HEADER^NURAED1,^DIE,Q Q
- EN7 ; CALLED BY OPTION NURAED-STF-EDUC
- D C I $D(NQUIT) D Q Q
- S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF4]" D HEADER^NURAED1,^DIE,^NURAEDCK,Q Q
- EN8 ; CALLED BY OPTION NURAED-STF-EXP
- D C I $D(NQUIT) D Q Q
- L +^NURSF(210,+NURSDBA,20,0):1 I '$T W $C(7),!!,"Another user is editing this employee's experience file.",!! Q
- S DA(1)=+NURSDBA,DA=DA(1) D HEADER^NURAED1 W !,"Employee's Professional Experience." S:'$D(^NURSF(210,DA(1),20,0)) ^(0)="^210.13AI^^"
- EN83 S ZZ=$P($G(^NURSF(210,DA(1),20,0)),U,3),Y=ZZ,ZZ=$S(ZZ'="":$P($G(^NURSF(210,DA(1),20,ZZ,0)),U),1:ZZ),XZ=ZZ
- EN85 S DIC="^NURSF(210,DA(1),20," W !!,"Select PROFESSIONAL EXPERIENCE: "_$S($G(ZZ)'="":$G(ZZ)_"// ",1:"") R X:DTIME G QQ:'$T!(X[U)!(ZZ=""&(X=""))!'($G(DA(1))) G DEL:X["@"
- I X="?" S YY=Y D
- . W !! S DIC="^NURSF(210,DA(1),20,",D0=DA(1) F Y=0:0 S Y=$O(^NURSF(210,DA(1),20,Y)) Q:Y'>0 D EN6^NURAED3
- . S DIC="^NURSF(211.5,",DZ="?",DIC(0)="",D="B" N X,Y D DQ^DICQ
- . Q
- I X="?" S Y=YY G EN85
- S:X="" X=ZZ S DIC="^NURSF(210,DA(1),20,",DIC(0)="EZ",DIC("W")="S NURSLO=^(0) D DICW^NURAED3" D ^DIC
- S XX=X S:X?1"""".PA1"""".P X=$P(X,"""",2)
- I Y=-1 S DIC(0)="EZ",DIC=211.5 D ^DIC D MS85:+Y'>0&(X?1A.E) G EN85:+Y'>0
- I '$D(^NURSF(210,DA(1),20,"B",$P(Y,U,2)))!(XX?1"""".PA1"""".P) S X=$P(Y,U,2),DIC="^NURSF(210,DA(1),20,",DIC(0)="LZ",DLAYGO=210.13 K DO,DD D FILE^DICN
- S XZ=Y(0,0) W !,"PROFESSIONAL EXPERIENCE: "_XZ_"// " R XX:DTIME G QQ:'$T!(XX=U),DEL:XX["@" I XX'="" D MS85 G EN85
- S DA=+Y,DIE="^NURSF(210,DA(1),20,",DR="3;1;2.1;2.5" D ^DIE I '$D(Y) S Y=DA,DA(1)=+NURSDBA L -^NURSF(210,+NURSDBA,20,0)
- S ZZ="" G EN85
- MS85 W $C(7),!!,"New clinical backgrounds can only be enter through Site File option!" Q
- DEL W $C(7),!?3,"SURE YOU WANT TO DELETE THE ENTIRE '",XZ,"' PROFESSIONAL EXPERIENCE"
- DEL1 S %=2 D YN^DICN I %=1 S DA=+Y,DIK=DIC D ^DIK S DA(1)=+NURSDBA W *7,!," <DELETED>" K DIK G EN83
- I %'=2 W !?2,"Enter 'Yes' or 'No'" G DEL1
- W $C(7),!," <NOTHING DELETED>"
- G EN85
- EN9 ; CALLED BY OPTION NURAED-STF-CERT
- D C I $D(NQUIT) D Q Q
- S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF7]" D HEADER^NURAED1,^DIE,Q Q
- EN10 ; CALLED BY OPTION NURAED-STF-MIL
- D C I $D(NQUIT) D Q Q
- S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF8]" D HEADER^NURAED1,^DIE,Q K NURSM,NURSX Q
- K NPTR,NNM,NSPOS,NSSN
- Q
- EN15 ;CALLED BY OPTION NURAED-STF-MENU EXIT ACTION
- K NURSDBA,DA,DIE,XQUIT,NI,NURSTAT,NURX
- Q
- C K NQUIT,NPREV I $S('$D(^DIC(213.9,1,"OFF")):1,$P(^("OFF"),"^")'=1:0,1:1) S NQUIT=1 Q
- I $S('$D(NURSDBA):1,$P(NURSDBA,"^",2)=210:0,1:1) D EN1^NURAED01 S NPREV=0 I $D(XQUIT) K XQUIT S NQUIT=1 Q
- Q
- QQ K %,%Y,D,D0,DDH,DLAYGO,DI,DIZ,DQ,I,NDA,NOD1,NOD2,NURS,NURSLO,NURSZ,X,XX,XZ,Y,ZZ
- Q D:($D(NQUIT)&'$D(ZX))!$D(NPREV) EN15 K NOD1,NOD2,DR,NQUIT,NPREV,DIC,DIE,DA,%DT,J Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAED0 4684 printed Jan 18, 2025@03:20:21 Page 2
- NURAED0 ;HIRMFO/RM,JH,FT-MODULE TO EDIT NURS STAFF FILE ;8/23/96 10:41
- +1 ;;4.0;NURSING SERVICE;**3**;Apr 25, 1997
- EN14 ; CALL FROM OPTION NURAED-STF-MENU
- +1 IF '$DATA(^DIC(213.9,1,"OFF"))
- SET XQUIT=1
- QUIT
- +2 IF $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- SET XQUIT=1
- QUIT
- +3 DO EN1^NURAED01
- +4 QUIT
- EN13 ; CALLED BY MENU OPTION NURAED-STF-ALL
- +1 DO C
- IF $DATA(NQUIT)
- DO Q
- QUIT
- +2 FOR ZX=1:1:10
- DO @("EN"_ZX)
- if ZX<10
- DO CONTASK
- if X=""
- QUIT
- +3 KILL %,ZX
- DO Q
- +4 QUIT
- CONTASK ;
- +1 SET %=1
- WRITE !!,"DO YOU WISH TO CONTINUE TO THE NEXT SECTION"
- DO YN^DICN
- +2 IF %=-1!(%=2)
- SET X=""
- QUIT
- +3 IF %=1
- SET X=1
- QUIT
- +4 WRITE !,"ANSWER YES OR NO"
- GOTO CONTASK
- EN1 ; CALLED BY OPTION NURAED-STF-DEMO
- +1 DO C
- IF $DATA(NQUIT)
- DO Q
- QUIT
- +2 SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- DO HEADER^NURAED1
- WRITE !,"Nursing Employee Demographic Data Edit. ",!
- +3 IF $SELECT('$DATA(^DIC(213.9,1,0)):0,$PIECE(^(0),"^",3)'=0:1,1:0)
- SET DIE=$PIECE(NURSDBA,"^",2)
- SET DA=+NURSDBA
- SET DR="[NURSAED-I-STAFFPR]"
- DO ^DIE
- KILL NURSX
- IF X=""
- DO Q
- QUIT
- +4 SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- SET DR="[NURSAED-I-STAFF1]"
- DO ^DIE
- DO Q
- QUIT
- EN2 ; CALLED BY OPTION NURAED-STF-PER
- +1 DO C
- IF $DATA(NQUIT)
- DO Q
- QUIT
- +2 SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- SET DR="[NURSAED-I-STAFFPD]"
- DO HEADER^NURAED1
- DO ^DIE
- DO Q
- QUIT
- EN3 ; CALLED BY OPTION NURAED-STF-STA/POS
- +1 DO C
- IF $DATA(NQUIT)
- DO Q
- QUIT
- +2 SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- DO HEADER^NURAED1
- WRITE !,"Employee's Status and Position.",!
- SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- SET DR=5.5
- DO ^DIE
- IF X=""
- DO Q
- QUIT
- +3 DO ^NURAED1
- IF '$GET(NUROUT)
- WRITE !!
- SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- SET DR="[NURSAED-I-STAFF2]"
- DO ^DIE
- +4 DO Q
- KILL NUROUT
- QUIT
- EN4 ; CALLED BY OPTION NURAED-STF-LIC
- +1 DO C
- IF $DATA(NQUIT)
- DO Q
- QUIT
- +2 SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- SET DR="[NURSAED-I-STAFF3]"
- DO HEADER^NURAED1
- DO ^DIE
- DO Q
- QUIT
- EN5 ; CALLED BY OPTION NURAED-STF-PROB
- +1 DO C
- IF $DATA(NQUIT)
- DO Q
- QUIT
- +2 SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- SET DR="[NURSAED-I-STAFF10]"
- DO HEADER^NURAED1
- DO ^DIE
- DO Q
- QUIT
- EN6 ; CALLED BY OPTION NURAED-STF-NPSB
- +1 DO C
- IF $DATA(NQUIT)
- DO Q
- QUIT
- +2 SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- SET DR="[NURSAED-I-STAFF11]"
- DO HEADER^NURAED1
- DO ^DIE
- DO Q
- QUIT
- EN7 ; CALLED BY OPTION NURAED-STF-EDUC
- +1 DO C
- IF $DATA(NQUIT)
- DO Q
- QUIT
- +2 SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- SET DR="[NURSAED-I-STAFF4]"
- DO HEADER^NURAED1
- DO ^DIE
- DO ^NURAEDCK
- DO Q
- QUIT
- EN8 ; CALLED BY OPTION NURAED-STF-EXP
- +1 DO C
- IF $DATA(NQUIT)
- DO Q
- QUIT
- +2 LOCK +^NURSF(210,+NURSDBA,20,0):1
- IF '$TEST
- WRITE $CHAR(7),!!,"Another user is editing this employee's experience file.",!!
- QUIT
- +3 SET DA(1)=+NURSDBA
- SET DA=DA(1)
- DO HEADER^NURAED1
- WRITE !,"Employee's Professional Experience."
- if '$DATA(^NURSF(210,DA(1),20,0))
- SET ^(0)="^210.13AI^^"
- EN83 SET ZZ=$PIECE($GET(^NURSF(210,DA(1),20,0)),U,3)
- SET Y=ZZ
- SET ZZ=$SELECT(ZZ'="":$PIECE($GET(^NURSF(210,DA(1),20,ZZ,0)),U),1:ZZ)
- SET XZ=ZZ
- EN85 SET DIC="^NURSF(210,DA(1),20,"
- WRITE !!,"Select PROFESSIONAL EXPERIENCE: "_$SELECT($GET(ZZ)'="":$GET(ZZ)_"// ",1:"")
- READ X:DTIME
- if '$TEST!(X[U)!(ZZ=""&(X=""))!'($GET(DA(1)))
- GOTO QQ
- if X["@"
- GOTO DEL
- +1 IF X="?"
- SET YY=Y
- Begin DoDot:1
- +2 WRITE !!
- SET DIC="^NURSF(210,DA(1),20,"
- SET D0=DA(1)
- FOR Y=0:0
- SET Y=$ORDER(^NURSF(210,DA(1),20,Y))
- if Y'>0
- QUIT
- DO EN6^NURAED3
- +3 SET DIC="^NURSF(211.5,"
- SET DZ="?"
- SET DIC(0)=""
- SET D="B"
- NEW X,Y
- DO DQ^DICQ
- +4 QUIT
- End DoDot:1
- +5 IF X="?"
- SET Y=YY
- GOTO EN85
- +6 if X=""
- SET X=ZZ
- SET DIC="^NURSF(210,DA(1),20,"
- SET DIC(0)="EZ"
- SET DIC("W")="S NURSLO=^(0) D DICW^NURAED3"
- DO ^DIC
- +7 SET XX=X
- if X?1"""".PA1"""".P
- SET X=$PIECE(X,"""",2)
- +8 IF Y=-1
- SET DIC(0)="EZ"
- SET DIC=211.5
- DO ^DIC
- if +Y'>0&(X?1A.E)
- DO MS85
- if +Y'>0
- GOTO EN85
- +9 IF '$DATA(^NURSF(210,DA(1),20,"B",$PIECE(Y,U,2)))!(XX?1"""".PA1"""".P)
- SET X=$PIECE(Y,U,2)
- SET DIC="^NURSF(210,DA(1),20,"
- SET DIC(0)="LZ"
- SET DLAYGO=210.13
- KILL DO,DD
- DO FILE^DICN
- +10 SET XZ=Y(0,0)
- WRITE !,"PROFESSIONAL EXPERIENCE: "_XZ_"// "
- READ XX:DTIME
- if '$TEST!(XX=U)
- GOTO QQ
- if XX["@"
- GOTO DEL
- IF XX'=""
- DO MS85
- GOTO EN85
- +11 SET DA=+Y
- SET DIE="^NURSF(210,DA(1),20,"
- SET DR="3;1;2.1;2.5"
- DO ^DIE
- IF '$DATA(Y)
- SET Y=DA
- SET DA(1)=+NURSDBA
- LOCK -^NURSF(210,+NURSDBA,20,0)
- +12 SET ZZ=""
- GOTO EN85
- MS85 WRITE $CHAR(7),!!,"New clinical backgrounds can only be enter through Site File option!"
- QUIT
- DEL WRITE $CHAR(7),!?3,"SURE YOU WANT TO DELETE THE ENTIRE '",XZ,"' PROFESSIONAL EXPERIENCE"
- DEL1 SET %=2
- DO YN^DICN
- IF %=1
- SET DA=+Y
- SET DIK=DIC
- DO ^DIK
- SET DA(1)=+NURSDBA
- WRITE *7,!," <DELETED>"
- KILL DIK
- GOTO EN83
- +1 IF %'=2
- WRITE !?2,"Enter 'Yes' or 'No'"
- GOTO DEL1
- +2 WRITE $CHAR(7),!," <NOTHING DELETED>"
- +3 GOTO EN85
- EN9 ; CALLED BY OPTION NURAED-STF-CERT
- +1 DO C
- IF $DATA(NQUIT)
- DO Q
- QUIT
- +2 SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- SET DR="[NURSAED-I-STAFF7]"
- DO HEADER^NURAED1
- DO ^DIE
- DO Q
- QUIT
- EN10 ; CALLED BY OPTION NURAED-STF-MIL
- +1 DO C
- IF $DATA(NQUIT)
- DO Q
- QUIT
- +2 SET DA=+NURSDBA
- SET DIE=$PIECE(NURSDBA,"^",2)
- SET DR="[NURSAED-I-STAFF8]"
- DO HEADER^NURAED1
- DO ^DIE
- DO Q
- KILL NURSM,NURSX
- QUIT
- +3 KILL NPTR,NNM,NSPOS,NSSN
- +4 QUIT
- EN15 ;CALLED BY OPTION NURAED-STF-MENU EXIT ACTION
- +1 KILL NURSDBA,DA,DIE,XQUIT,NI,NURSTAT,NURX
- +2 QUIT
- C KILL NQUIT,NPREV
- IF $SELECT('$DATA(^DIC(213.9,1,"OFF")):1,$PIECE(^("OFF"),"^")'=1:0,1:1)
- SET NQUIT=1
- QUIT
- +1 IF $SELECT('$DATA(NURSDBA):1,$PIECE(NURSDBA,"^",2)=210:0,1:1)
- DO EN1^NURAED01
- SET NPREV=0
- IF $DATA(XQUIT)
- KILL XQUIT
- SET NQUIT=1
- QUIT
- +2 QUIT
- QQ KILL %,%Y,D,D0,DDH,DLAYGO,DI,DIZ,DQ,I,NDA,NOD1,NOD2,NURS,NURSLO,NURSZ,X,XX,XZ,Y,ZZ
- Q if ($DATA(NQUIT)&'$DATA(ZX))!$DATA(NPREV)
- DO EN15
- KILL NOD1,NOD2,DR,NQUIT,NPREV,DIC,DIE,DA,%DT,J
- QUIT