95 lines
5.6 KiB
Mathematica
95 lines
5.6 KiB
Mathematica
NURSUT2 ;HIRMFO/MD,RM,FT-UTILITIES FOR FILES 210 AND 211.8 ;01/06/97
|
|
;;4.0;NURSING SERVICE;**3,33**;Apr 25, 1997
|
|
;
|
|
; Reference to ^SC is supported by IA #1416
|
|
;
|
|
EN1 ;GET THE TOTAL EMPLOYEE FTEE
|
|
; INPUT VARIABLES: NUR("DA")=ENTRY IN FILE 210 FOR NURSING EMPLOYEE
|
|
; NUR("DT")=DATE AT WHICH TOTAL FTEE TO BE CALCULATED
|
|
; (OPTIONAL VARIABLE DT IS USED IF NOT SUPPLIED)
|
|
; OUTPUT VARIABLE: NURTFTEE=TOTAL ASSIGNMENT FTEE
|
|
S:'$D(NUR("DT")) NUR("DT")=DT S NUR=$S($D(^NURSF(210,NUR("DA"),0)):$P(^(0),U),1:"")
|
|
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
|
|
K NUR
|
|
Q
|
|
TOTX 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)
|
|
Q
|
|
EN2 ;VARIABLE D0=NURS EMPLOYEE IEN IS PASSED IN TO COMPUTE PRIMARY LOCATION
|
|
S NUR="",NUR(3)=$S($D(^NURSF(210,D0,0)):$P(^(0),U),1:"")
|
|
F NUR(0)=0:0 S NUR(0)=$O(^NURSF(211.8,"AE",+NUR(3),1,NUR(0))) Q:NUR(0)'>0 D S2
|
|
S X=NUR K NUR
|
|
Q
|
|
S2 ;
|
|
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
|
|
Q
|
|
SETLOC 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:"")
|
|
Q
|
|
EN3 ; ENTRY TO DETERMINE IF A POSITION CHANGE WILL CREATE DUPLICATE
|
|
; PRIMARY ASSIGNMENTS, MAKE TOTAL FTEE>1, MAKE THE START DATE
|
|
; AFTER THE VACANCY DATE OF THE ASSIGNMENT, OR CREATE DUPLICATE
|
|
; SERVICE POSITIONS ON THE SAME LOCATION
|
|
; INPUT VARIABLES: DA(1) AND DA = DEFINE THE POSITION ENTRY
|
|
; NUR(0)=DATA TO BE FILED IN ZEROTH NODE; AND OF THE
|
|
; SAME STRUCTURE AS THE ZEROTH NODE.
|
|
; OUTPUT VARIABLES: NURSBAD=$S(0:NO PROB,1:PROB)^$S(1:FTEE>1,2:DUP PRI,
|
|
;4:DUP SP,7:DUP TOUR)
|
|
S NURZ=NUR(0) K NUR S NUR(0)=NURZ
|
|
S NUR("CNTR")=1
|
|
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
|
|
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)
|
|
EN4 ; ENTRY FROM ASSIGNMENT EDIT TO VALIDATE POSITION ENTRY.
|
|
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))
|
|
F NUR("SDT")=0:0 S NUR("SDT")=$O(NUR("SDT",NUR("SDT"))) Q:NUR("SDT")'>0 D Q:+NURSBAD
|
|
. F NUR(1)=0:0 S NUR(1)=$O(NUR("SDT",NUR("SDT"),NUR(1))) Q:NUR(1)'>0 D Q:+NURSBAD
|
|
. . 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
|
|
. . Q
|
|
. Q
|
|
S:'+NURSBAD&'NUR("PRI") NURSBAD=$S(NUR("CNTR")'>1:"1^5",1:"1^6")
|
|
K NUR,NURZ,NX
|
|
Q
|
|
STPOAR ;
|
|
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
|
|
Q
|
|
ST1 ;
|
|
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
|
|
Q
|
|
DTPRC ;
|
|
I NUR("SDT")>NUR("VDT") D VACDT
|
|
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)
|
|
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)
|
|
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
|
|
. I $P(NUR("SP",NX(0)),U,1,2)=$P($G(NUR("SP",NX(0)+1)),U,1,2) S NUR("SP")=2
|
|
. 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
|
|
. Q
|
|
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)
|
|
S:+NURSBAD&($P(NURSBAD,U,2)=5) $P(NURSNPOS,U,11)=1,NURSPOS(1)=NURSNPOS
|
|
Q
|
|
VACDT ;
|
|
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
|
|
Q
|
|
VAC1 ;
|
|
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)
|
|
Q
|
|
CAT(NURCAT) ; Input: Service Category code (i.e, R, L, N, A, S, C, O or
|
|
; O_<space>_sub-category value)
|
|
; Ouput: Expanded value of Service Category.
|
|
;
|
|
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)
|
|
I $P(NURCAT,"O ",2)'="" S NURCAT=$E(NURCAT,3,$L(NURCAT)),NURCAT=$E(NURCAT,1,6)
|
|
Q NURCAT
|
|
CNTR(NURPARM) ; Center Printed String
|
|
;
|
|
; Input: Item to be centered
|
|
; Output: Value of print position to center string in report line
|
|
N X,NURCNTR S X=$S(+$G(NURS132):132,1:80),NURCNTR=(X/2)-($L(NURPARM)/2)
|
|
Q NURCNTR
|
|
PROD(NURPROG) ; Input: Nurs Product Line free text value
|
|
; Output: Expanded value of Service Category.
|
|
;
|
|
S NURPPROD="",NURPPROD=$S(NURPROG=" BLANK":"NO PRODUCT LINE",$E(NURPROG)=" ":$E(NURPROG,2,99),1:NURPROG)
|
|
Q NURPPROD
|
|
FACL(NURFAC) ; Input: Facility free text value.
|
|
; Output: Printable Facility value.
|
|
S NURPFAC="",NURPFAC=$S(NURFAC=" BLANK":"NO FACILITY",1:NURFAC)
|
|
Q NURPFAC
|