source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURSUT2.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1NURSUT2 ;HIRMFO/MD,RM,FT-UTILITIES FOR FILES 210 AND 211.8 ;01/06/97
2 ;;4.0;NURSING SERVICE;**3,33**;Apr 25, 1997
3 ;
4 ; Reference to ^SC is supported by IA #1416
5 ;
6EN1 ;GET THE TOTAL EMPLOYEE FTEE
7 ; INPUT VARIABLES: NUR("DA")=ENTRY IN FILE 210 FOR NURSING EMPLOYEE
8 ; NUR("DT")=DATE AT WHICH TOTAL FTEE TO BE CALCULATED
9 ; (OPTIONAL VARIABLE DT IS USED IF NOT SUPPLIED)
10 ; OUTPUT VARIABLE: NURTFTEE=TOTAL ASSIGNMENT FTEE
11 S:'$D(NUR("DT")) NUR("DT")=DT S NUR=$S($D(^NURSF(210,NUR("DA"),0)):$P(^(0),U),1:"")
12 S NURTFTEE=0 F NUR(0)=0:0 S NUR(0)=$O(^NURSF(211.8,"C",+NUR,NUR(0))) Q:NUR(0)'>0 D TOTX
13 K NUR
14 Q
15TOTX F NUR(1)=0:0 S NUR(1)=$O(^NURSF(211.8,"C",+NUR,NUR(0),NUR(1))) Q:NUR(1)'>0 I $D(^NURSF(211.8,NUR(0),1,NUR(1),0)) S NUR(2)=^(0) I +NUR(2)'>NUR("DT"),('+$P(NUR(2),U,6)!(+$P(NUR(2),U,6)'<NUR("DT"))) S NURTFTEE=NURTFTEE+$P(NUR(2),U,4)
16 Q
17EN2 ;VARIABLE D0=NURS EMPLOYEE IEN IS PASSED IN TO COMPUTE PRIMARY LOCATION
18 S NUR="",NUR(3)=$S($D(^NURSF(210,D0,0)):$P(^(0),U),1:"")
19 F NUR(0)=0:0 S NUR(0)=$O(^NURSF(211.8,"AE",+NUR(3),1,NUR(0))) Q:NUR(0)'>0 D S2
20 S X=NUR K NUR
21 Q
22S2 ;
23 F NUR(1)=0:0 S NUR(1)=$O(^NURSF(211.8,"AE",+NUR(3),1,NUR(0),NUR(1))) Q:NUR(1)'>0 I $D(^NURSF(211.8,NUR(0),1,NUR(1),0)) S NUR(2)=^(0) D:+NUR(2) SETLOC
24 Q
25SETLOC I DT'<+$P(NUR(2),U),(DT<+$P(NUR(2),U,6)!'+$P(NUR(2),U,6)) S NUR=$S($D(^SC(+$S($D(^NURSF(211.8,NUR(0),0)):$P(^(0),U),1:""),0)):$P(^(0),U),1:""),NUR=$S(NUR?1"NUR ".E:$P(NUR,"NUR ",2),1:"")
26 Q
27EN3 ; ENTRY TO DETERMINE IF A POSITION CHANGE WILL CREATE DUPLICATE
28 ; PRIMARY ASSIGNMENTS, MAKE TOTAL FTEE>1, MAKE THE START DATE
29 ; AFTER THE VACANCY DATE OF THE ASSIGNMENT, OR CREATE DUPLICATE
30 ; SERVICE POSITIONS ON THE SAME LOCATION
31 ; INPUT VARIABLES: DA(1) AND DA = DEFINE THE POSITION ENTRY
32 ; NUR(0)=DATA TO BE FILED IN ZEROTH NODE; AND OF THE
33 ; SAME STRUCTURE AS THE ZEROTH NODE.
34 ; OUTPUT VARIABLES: NURSBAD=$S(0:NO PROB,1:PROB)^$S(1:FTEE>1,2:DUP PRI,
35 ;4:DUP SP,7:DUP TOUR)
36 S NURZ=NUR(0) K NUR S NUR(0)=NURZ
37 S NUR("CNTR")=1
38 F NUR=0:0 S NUR=$O(^NURSF(211.8,"ASDT",+$P(NUR(0),U,4),NUR)) Q:$S(NUR'>0:1,'$P(NUR(0),U,8):0,NUR>$P(NUR(0),U,8):1,1:0) F NUR(1)=0:0 S NUR(1)=$O(^NURSF(211.8,"ASDT",+$P(NUR(0),U,4),NUR,NUR(1))) Q:NUR(1)'>0 D STPOAR
39 S (NUR("SDT",+$P(NUR(0),U,3),DA(1),DA),NUR("VDT",$S(+$P(NUR(0),U,8):$P(NUR(0),U,8),1:9999999),DA(1),DA))=NUR(0)
40EN4 ; ENTRY FROM ASSIGNMENT EDIT TO VALIDATE POSITION ENTRY.
41 Q:$G(NURLS)="P" S (NURSBAD,NUR("TFTE"),NUR("PRI"),NUR("SP"),NUR("SP",1),NUR("TOUR"),NX)=0,NUR("VDT")=$O(NUR("VDT",0))
42 F NUR("SDT")=0:0 S NUR("SDT")=$O(NUR("SDT",NUR("SDT"))) Q:NUR("SDT")'>0 D Q:+NURSBAD
43 . F NUR(1)=0:0 S NUR(1)=$O(NUR("SDT",NUR("SDT"),NUR(1))) Q:NUR(1)'>0 D Q:+NURSBAD
44 . . F NUR(2)=0:0 S NUR(2)=$O(NUR("SDT",NUR("SDT"),NUR(1),NUR(2))) Q:NUR(2)'>0 D DTPRC Q:+NURSBAD
45 . . Q
46 . Q
47 S:'+NURSBAD&'NUR("PRI") NURSBAD=$S(NUR("CNTR")'>1:"1^5",1:"1^6")
48 K NUR,NURZ,NX
49 Q
50STPOAR ;
51 F NUR(2)=0:0 S NUR(2)=$O(^NURSF(211.8,"ASDT",+$P(NUR(0),U,4),NUR,NUR(1),NUR(2))) Q:NUR(2)'>0 S NUR(3)=$S($D(^NURSF(211.8,NUR(1),1,NUR(2),0)):^(0),1:"") I $P(NUR(3),U,6)'<$P(NUR(0),U,3)!'$P(NUR(3),U,6) D ST1
52 Q
53ST1 ;
54 S:$S('(NUR(1)=DA(1)&(NUR(2)=DA)):1,1:0) (NUR("SDT",$P(NUR(3),U),NUR(1),NUR(2)),NUR("VDT",$S($P(NUR(3),U,6):$P(NUR(3),U,6),1:9999999),NUR(1),NUR(2)))=$P($G(^NURSF(211.8,NUR(1),0)),"^",1,2)_"^"_NUR(3),NUR("CNTR")=NUR("CNTR")+1
55 Q
56DTPRC ;
57 I NUR("SDT")>NUR("VDT") D VACDT
58 S NUR("TFTE")=NUR("TFTE")+$P(NUR("SDT",NUR("SDT"),NUR(1),NUR(2)),U,6),NUR("PRI")=$S('$P(NUR("SDT",NUR("SDT"),NUR(1),NUR(2)),U,11):NUR("PRI"),NUR("PRI"):2,1:1)
59 S NX=NX+1 S NUR("SP",NX)=$P(NUR("SDT",NUR("SDT"),NUR(1),NUR(2)),U)_U_$P(NUR("SDT",NUR("SDT"),NUR(1),NUR(2)),U,5)_U_$P(NUR("SDT",NUR("SDT"),NUR(1),NUR(2)),U,8)_U_$P(NUR("SDT",NUR("SDT"),NUR(1),NUR(2)),U,12)
60 I NX>1 F NX(0)=1:1:NX I '+$P(NUR("SP",NX(0)),U,3)!((+$P(NUR("SP",NX(0)),U,3)'<DT)&(+$P(NUR("SP",NX(0)),U,3)'>DT)) D
61 . I $P(NUR("SP",NX(0)),U,1,2)=$P($G(NUR("SP",NX(0)+1)),U,1,2) S NUR("SP")=2
62 . I ($P(NUR("SP",NX(0)),U)_U_$P(NUR("SP",NX(0)),U,4))=($P($G(NUR("SP",NX(0)+1)),U)_U_$P($G(NUR("SP",NX(0)+1)),U,4)) S NUR("TOUR")=2
63 . Q
64 S NURSBAD=$S(NUR("TFTE")>1:"1^1",NUR("PRI")>1:"1^2",NUR("SDT")>NUR("VDT"):"1^3",NUR("SP")=2:"1^4",NUR("TOUR")=2:"1^7",1:0)
65 S:+NURSBAD&($P(NURSBAD,U,2)=5) $P(NURSNPOS,U,11)=1,NURSPOS(1)=NURSNPOS
66 Q
67VACDT ;
68 F NUR("VDT")=NUR("VDT")-.1:0 S NUR("VDT")=$O(NUR("VDT",NUR("VDT"))) Q:NUR("VDT")'<NUR("SDT")!(NUR("VDT")'>0) F NUR(4)=0:0 S NUR(4)=$O(NUR("VDT",NUR("VDT"),NUR(4))) Q:NUR(4)'>0 D VAC1
69 Q
70VAC1 ;
71 F NUR(5)=0:0 S NUR(5)=$O(NUR("VDT",NUR("VDT"),NUR(4),NUR(5))) Q:NUR(5)'>0 S NUR("TFTE")=NUR("TFTE")-$P(NUR("VDT",NUR("VDT"),NUR(4),NUR(5)),U,6),NUR("PRI")=$S('$P(NUR("VDT",NUR("VDT"),NUR(4),NUR(5)),U,11):NUR("PRI"),1:0)
72 Q
73CAT(NURCAT) ; Input: Service Category code (i.e, R, L, N, A, S, C, O or
74 ; O_<space>_sub-category value)
75 ; Ouput: Expanded value of Service Category.
76 ;
77 S NURCAT=$S(NURCAT="R":"RN",NURCAT="L":"LPN",NURCAT="C":"CK",NURCAT="N":"NA",NURCAT="S":"SE",NURCAT="A":"AO",NURCAT="O":"OT",1:NURCAT)
78 I $P(NURCAT,"O ",2)'="" S NURCAT=$E(NURCAT,3,$L(NURCAT)),NURCAT=$E(NURCAT,1,6)
79 Q NURCAT
80CNTR(NURPARM) ; Center Printed String
81 ;
82 ; Input: Item to be centered
83 ; Output: Value of print position to center string in report line
84 N X,NURCNTR S X=$S(+$G(NURS132):132,1:80),NURCNTR=(X/2)-($L(NURPARM)/2)
85 Q NURCNTR
86PROD(NURPROG) ; Input: Nurs Product Line free text value
87 ; Output: Expanded value of Service Category.
88 ;
89 S NURPPROD="",NURPPROD=$S(NURPROG=" BLANK":"NO PRODUCT LINE",$E(NURPROG)=" ":$E(NURPROG,2,99),1:NURPROG)
90 Q NURPPROD
91FACL(NURFAC) ; Input: Facility free text value.
92 ; Output: Printable Facility value.
93 S NURPFAC="",NURPFAC=$S(NURFAC=" BLANK":"NO FACILITY",1:NURFAC)
94 Q NURPFAC
Note: See TracBrowser for help on using the repository browser.