source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURAED0.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1NURAED0 ;HIRMFO/RM,JH,FT-MODULE TO EDIT NURS STAFF FILE ;8/23/96 10:41
2 ;;4.0;NURSING SERVICE;**3**;Apr 25, 1997
3EN14 ; CALL FROM OPTION NURAED-STF-MENU
4 I '$D(^DIC(213.9,1,"OFF")) S XQUIT=1 Q
5 I $P(^DIC(213.9,1,"OFF"),"^",1)=1 S XQUIT=1 Q
6 D EN1^NURAED01
7 Q
8EN13 ; CALLED BY MENU OPTION NURAED-STF-ALL
9 D C I $D(NQUIT) D Q Q
10 F ZX=1:1:10 D @("EN"_ZX) D:ZX<10 CONTASK Q:X=""
11 K %,ZX D Q
12 Q
13CONTASK ;
14 S %=1 W !!,"DO YOU WISH TO CONTINUE TO THE NEXT SECTION" D YN^DICN
15 I %=-1!(%=2) S X="" Q
16 I %=1 S X=1 Q
17 W !,"ANSWER YES OR NO" G CONTASK
18EN1 ; CALLED BY OPTION NURAED-STF-DEMO
19 D C I $D(NQUIT) D Q Q
20 S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2) D HEADER^NURAED1 W !,"Nursing Employee Demographic Data Edit. ",!
21 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
22 S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF1]" D ^DIE,Q Q
23EN2 ; CALLED BY OPTION NURAED-STF-PER
24 D C I $D(NQUIT) D Q Q
25 S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFFPD]" D HEADER^NURAED1,^DIE,Q Q
26EN3 ; CALLED BY OPTION NURAED-STF-STA/POS
27 D C I $D(NQUIT) D Q Q
28 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
29 D ^NURAED1 I '$G(NUROUT) W !! S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF2]" D ^DIE
30 D Q K NUROUT Q
31EN4 ; CALLED BY OPTION NURAED-STF-LIC
32 D C I $D(NQUIT) D Q Q
33 S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF3]" D HEADER^NURAED1,^DIE,Q Q
34EN5 ; CALLED BY OPTION NURAED-STF-PROB
35 D C I $D(NQUIT) D Q Q
36 S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF10]" D HEADER^NURAED1,^DIE,Q Q
37EN6 ; CALLED BY OPTION NURAED-STF-NPSB
38 D C I $D(NQUIT) D Q Q
39 S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF11]" D HEADER^NURAED1,^DIE,Q Q
40EN7 ; CALLED BY OPTION NURAED-STF-EDUC
41 D C I $D(NQUIT) D Q Q
42 S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF4]" D HEADER^NURAED1,^DIE,^NURAEDCK,Q Q
43EN8 ; CALLED BY OPTION NURAED-STF-EXP
44 D C I $D(NQUIT) D Q Q
45 L +^NURSF(210,+NURSDBA,20,0):1 I '$T W $C(7),!!,"Another user is editing this employee's experience file.",!! Q
46 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^^"
47EN83 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
48EN85 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["@"
49 I X="?" S YY=Y D
50 . 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
51 . S DIC="^NURSF(211.5,",DZ="?",DIC(0)="",D="B" N X,Y D DQ^DICQ
52 . Q
53 I X="?" S Y=YY G EN85
54 S:X="" X=ZZ S DIC="^NURSF(210,DA(1),20,",DIC(0)="EZ",DIC("W")="S NURSLO=^(0) D DICW^NURAED3" D ^DIC
55 S XX=X S:X?1"""".PA1"""".P X=$P(X,"""",2)
56 I Y=-1 S DIC(0)="EZ",DIC=211.5 D ^DIC D MS85:+Y'>0&(X?1A.E) G EN85:+Y'>0
57 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
58 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
59 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)
60 S ZZ="" G EN85
61MS85 W $C(7),!!,"New clinical backgrounds can only be enter through Site File option!" Q
62DEL W $C(7),!?3,"SURE YOU WANT TO DELETE THE ENTIRE '",XZ,"' PROFESSIONAL EXPERIENCE"
63DEL1 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
64 I %'=2 W !?2,"Enter 'Yes' or 'No'" G DEL1
65 W $C(7),!," <NOTHING DELETED>"
66 G EN85
67EN9 ; CALLED BY OPTION NURAED-STF-CERT
68 D C I $D(NQUIT) D Q Q
69 S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF7]" D HEADER^NURAED1,^DIE,Q Q
70EN10 ; CALLED BY OPTION NURAED-STF-MIL
71 D C I $D(NQUIT) D Q Q
72 S DA=+NURSDBA,DIE=$P(NURSDBA,"^",2),DR="[NURSAED-I-STAFF8]" D HEADER^NURAED1,^DIE,Q K NURSM,NURSX Q
73 K NPTR,NNM,NSPOS,NSSN
74 Q
75EN15 ;CALLED BY OPTION NURAED-STF-MENU EXIT ACTION
76 K NURSDBA,DA,DIE,XQUIT,NI,NURSTAT,NURX
77 Q
78C K NQUIT,NPREV I $S('$D(^DIC(213.9,1,"OFF")):1,$P(^("OFF"),"^")'=1:0,1:1) S NQUIT=1 Q
79 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
80 Q
81QQ K %,%Y,D,D0,DDH,DLAYGO,DI,DIZ,DQ,I,NDA,NOD1,NOD2,NURS,NURSLO,NURSZ,X,XX,XZ,Y,ZZ
82Q D:($D(NQUIT)&'$D(ZX))!$D(NPREV) EN15 K NOD1,NOD2,DR,NQUIT,NPREV,DIC,DIE,DA,%DT,J Q
Note: See TracBrowser for help on using the repository browser.