source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURAED1.m@ 1328

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1NURAED1 ;HIRMFO/MD,RM-EDIT FOR POSITION ;8/19/97
2 ;;4.0;NURSING SERVICE;**3,12**;Apr 25, 1997
3 S NUROUT=0,NID=$S($D(^NURSF(210,+NURSDBA,0)):$P(^(0),U),1:"") D STST^NURAED4 G QB:$G(NUROUT)
4SELECT K NURSUL,NURSASS D WRITE
5NOPOS I '$O(NURSASS("")) S NURAES="N" W !!,"THERE ARE NO ",$S(NURLS="P":"PAST ",NURLS="C":"CURRENT ",1:""),"EMPLOYEE ASSIGNMENTS " W:NURLS="P" "AFTER SELECTED DATE"
6NOPOS1 I '$O(NURSASS("")),NURLS="P" S %=1 W !!,"Would you like to see this employee's current position(s)" D YN^DICN W:%=0 !,$C(7),"Answer 'YES' or 'NO'" G:%=0 NOPOS Q:%'>0!(%=2) S NURLS="C" D WRITE G NOPOS
7 I $O(NURSASS("")) D WRT1 W !!,"Enter selection or type ? for help: " R NURAES:DTIME S NURAES=$S(NURAES="n":"N",1:NURAES) S:NURAES=U!(NURAES="^^")!'$T NUROUT=1 G:$G(NUROUT)!(NURAES="") QB
8 I NURLS="P",NURAES="N" W $C(7),!!,"NEW ASSIGNMENTS MUST BE ADDED FROM THE CURRENT DISPLAY SCREEN" G SELECT
9 W ! S NURSBAD=0 D VALSEL^NURAED2 I NURSBAD D MORHELP^NURAED4 G QB:$G(NUROUT),SELECT
10 D EN1^NURAED2 G QB:$G(NUROUT),SELECT:$D(MSG)
11 S NUR("CNTR")=0 F NURSANM=0:0 S NURSANM=$O(NURSASS(NURSANM)) Q:NURSANM'>0 D VALE0^NURAED2
12 D VALENT^NURAED2 I $G(NUROUT) S NUROUT=0 G SELECT
13 D EN1^NURAED6 G:'$G(NUROUT)&$O(NURSASS("")) SELECT
14QB K %,NURCAT,NL1,X,Y,Z,MSG,NURSUL,NUR1,NUR2,NUR3,NURAES,NURAS,NUR10,NURSBAD,NX,NURY,NWARD
15QC ; KILL VARIABLES
16 K NURSW1,NID,NCNT,NURSASS,NDA,I,J,NPSPOS,NURTFTEE,NPWARD,NDATA,NURSANM,NOD,NURST,NURSTDT,DA,NURLS,NURSNPOS,NURSOPOS,NURSPOS,NURSX,NZ,NOD1,NOD2,NURSDFLT,NURFLAG
17 Q
18HEADER ;HEADER FOR ALL INPUTS
19 S IOP=ION D ^%ZIS K IOP D EN2^NURSUT0 S NNM=$S($D(^VA(200,$P(^NURSF(210,+NURSDBA,0),U),0)):$P(^(0),U),1:+NURSDBA),NSSN=$S($D(^VA(200,$P(^NURSF(210,+NURSDBA,0),U),1)):$P(^(1),U,9),1:"")
20 I $D(^VA(200,$P(^NURSF(210,+NURSDBA,0),U),0)) W @IOF,!!,?25,"EMPLOYEE: ",$P(^VA(200,$P(^NURSF(210,+NURSDBA,0),U),0),U) W:$D(NPSPOS) ?$X+2,NPSPOS W !,?25,"SSN: ",NSSN,!!
21 K NPTR,NNM,NPSPOS,NSSN
22 Q
23WRITE ; CALL TO DISPLAY THE POSITIONS FOR THIS STAFF MEMBER
24 ; +NURSDBA=210 FILE ENTRY, NURSTDT=DATE FOR WHICH LISTING BEGINS
25 K NURAS,NURASS S NURSW1=1,NCNT=0
26 F NOD=0:0 S NOD=$O(^NURSF(211.8,"C",+NID,NOD)) Q:NOD'>0 F NDA=0:0 S NDA=$O(^NURSF(211.8,"C",+NID,NOD,NDA)) Q:NDA'>0 I $D(^NURSF(211.8,NOD,1,NDA,0)) S NDATA=^(0) D CKASN
27 F I=-1:0 S I=$O(NURAS(I)) Q:I'>0 F J=-1:0 S J=$O(NURAS(I,J)) Q:J'>0 F NOD=0:0 S NOD=$O(NURAS(I,J,NOD)) Q:NOD'>0 F NDA=0:0 S NDA=$O(NURAS(I,J,NOD,NDA)) Q:NDA'>0 D SETARY
28 Q
29WRT1 ; POSITION DISPLAY
30 F NURSANM=0:0 S NURSANM=$O(NURSASS(NURSANM)) Q:NURSANM'>0 D DISPLAY
31 Q:'$O(NURSASS(""))
32 W !!?24,"STATUS: ",$S($P(^NURSF(210,+NURSDBA,0),U,2)="A":"ACTIVE",$P(^(0),U,2)="I":"INTERMITTENT",1:"INACTIVE")
33 S DA=+NURSDBA K NPSPOS D EN2^NURSUT0
34 I $G(NPSPOS)'="" W !?6,"PRIMARY SERVICE POSITION: ",$E($P(^NURSF(211.3,NPSPOS(0),0),U,2),1,24)
35 I NURPLSW,$G(NPSPOS(2))'="" W !,"PRIMARY SVC. POS. PRODUCT LINE: ",NPSPOS(2)
36 I NURPLSW,$G(NPSPOS(4))'="" W !?1,"PRIMARY LOCATION PRODUCT LINE: ",NPSPOS(4)
37 I $P($G(^DIC(213.9,1,0)),U,9)="Y" W !?14,"PRIMARY FACILITY: ",$G(NPSPOS(3))
38 I $D(^NURSF(211.8,"C",+NID)) S NUR("DA")=+NURSDBA D EN1^NURSUT2 W:+NURTFTEE&("C"[NURLS) !,?9,"TOTAL ASSIGNMENT FTEE: ",$J(NURTFTEE,2,3)
39 E W !
40 K NURAS Q
41DISPLAY ; DATA DISPLAY
42 S (NURPLSW,NURMDSW)=0 D EN9^NURSAGSP S NDATA=$P(NURSASS(NURSANM),U,5,14)
43 I NURSW1 W !!,"LOCATION"_$S($G(NURPLSW):"/",1:""),?16,"POSITION"_$S($G(NURPLSW):"/",1:""),?33,"DUTY",?49,"START",?59,"VACANCY",?70,"FTEE"
44 I NURSW1 W ! W:NURPLSW "PRODUCT LINE" W:NURPLSW ?16,"PRODUCT LINE" W ?33,"TOUR",?49,"DATE",?59,"DATE",! S Z="",$P(Z,"-",80)="" W Z S NURSW1=0
45 W !,NURSANM,$S($P(NDATA,U,9):" (P)",1:"")
46 S NPWARD=$P(NURSASS(NURSANM),U,3) D EN7^NURSAUTL W ?6,$S(NPWARD'="":$E(NPWARD,1,10),1:$P(NURSASS(NURSANM),U,3))
47 I $P(NDATA,U,3)'="" W ?19,$S($D(^NURSF(211.3,+$P(NDATA,U,3),0)):$P(^(0),U),1:$P(NDATA,U,3))
48 I $P(NDATA,U,10)'="" W ?33,$S($D(^NURSF(211.6,+$P(NDATA,U,10),0)):$E($P(^(0),U),1,15),1:$P(NDATA,U,10))
49 W ?49,$E(+NDATA,4,5)_"/"_$E(+NDATA,6,7)_"/"_$E(+NDATA,2,3) W:+$P(NDATA,U,6) ?59,$E(+$P(NDATA,U,6),4,5)_"/"_$E(+$P(NDATA,U,6),6,7)_"/"_$E(+$P(NDATA,U,6),2,3) W ?70,$J($P(NDATA,U,4),2,3)
50 I $G(NURPLSW) W !,?2,$E($$EN13^NURSUT3(+$G(NURSASS(NURSANM))),1,17) S X=+$P(NDATA,U,3),Y=+$P(^NURSF(211.3,+X,0),U,7) W ?21,$E($$GET1^DIQ(212.7,+Y,.01,"I"),1,17)
51 Q
52SETARY ; SET NURSASS ARRAY FROM NURAS ARRAY
53 S NCNT=NCNT+1,NURSASS(NCNT)=NOD_U_NDA_U_NURAS(I,J,NOD,NDA)
54 Q
55CKASN ; SET NURAS ARRAY FOR POSITIONS ACTIVE AFTER NURSTDT
56 Q:$S(NURLS="A"&$P(NDATA,U,6)&($P(NDATA,U,6)<NURSTDT):1,NURLS="C"&(($P(NDATA,U,6)&($P(NDATA,U,6)<NURSTDT))):1,1:0)
57 Q:$S(NURLS="P"&('$P(NDATA,U,6)!($P(NDATA,U,6)>DT)!($P(NDATA,U,6)<NURSTDT)!($P(NDATA,U)'<DT)):1,1:0)
58 I $S(NURLS="P":1,1:0) S NURAS(9999999-$S($P(NDATA,U,6):$P(NDATA,U,6),1:9999998),1-$P(NDATA,U,9)+1,NOD,NDA)=$S($D(^NURSF(211.8,NOD,0)):$P(^(0),U,1,2),1:U)_U_NDATA Q
59 S NURAS(9999999-$P(NDATA,U),1-$P(NDATA,U,9)+1,NOD,NDA)=$S($D(^NURSF(211.8,NOD,0)):$P(^(0),U,1,2),1:U)_U_NDATA
60 Q
61MSG W $C(7),!!,"NEW ASSIGNMENTS MUST BE ADDED FROM THE CURRENT DISPLAY SCREEN." Q
Note: See TracBrowser for help on using the repository browser.