source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSUT3.m@ 836

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

initial load of WorldVistAEHR
File size: 6.4 KB
RevLine 
[613]1NURSUT3 ;HIRMFO/RM,MD-UTILITIES FOR FILES 210 AND 211.8 ; 3/4/03 10:51am
2 ;;4.0;NURSING SERVICE;**33,38**;Apr 25, 1997
3 ;
4 ; Reference to ^SC is supported by IA #1416
5 ; Reference to File #454.1 is supported by IA #1404
6 ; ^XSEC is covered by supported reference #10076
7 ;
8EN1 ; INPUT TRANSFORM FOR THE VACANCY DATE (#3) OF THE OCCUPANCY/TRANS.
9 ; DATE (#2) FIELD OF THE POSITION CONTROL FILE.
10 S NUR(0)=$P($G(^NURSF(211.8,DA(1),0)),U,1,2)_U_$S($D(^NURSF(211.8,DA(1),1,DA,0)):^(0),1:""),NURSBAD=$S(Y'>+NUR(0):"1^3",1:0)
11 I 'NURSBAD S $P(NUR(0),U,8)=X D EN3^NURSUT2
12 K:NURSBAD X D EN4
13 Q
14EN2 ; ENTRY FROM INPUT TRANSFORM FOR 1 & 1.5 SUBFIELDS OF FIELD 27
15 ; OF FILE 210
16 S NURS(0)=$S($D(^NURSF(210,DA(1),18,DA,0)):^(0),1:""),NURS("HELP")="DATE MUST BE "_$P("GREATER THAN DATE STARTED ^LESS THAN DATE ENDED ",U,NURS*10=10+1),%DT(0)=+($E("-",NURS*10=10)_$P(NURS(0),U,$E(24,NURS*10=10+1)))
17 K:%DT(0)=0 %DT(0) S %DT="E" D ^%DT S X=Y I Y<1 W !?5,NURS("HELP") K X
18 K %DT,NURS
19 Q
20EN3 ; ENTRY FROM INPUT TRANSFORM ON SUBFIELD .01 OF SUBFIELD 5.5 OF
21 ; FIELD 27 IN FILE 20
22 S NURS=0 F D1=0:0 S D1=$O(^NURSF(210,DA(2),18,D1)) Q:D1'>0 F D2=0:0 S D2=$O(^NURSF(210,DA(2),18,D1,1,D2)) Q:D2'>0 I $D(^NURSF(210,DA(2),18,D1,1,D2,0)) S NURS(0)=$P(^(0),U) S:X=$P(NURS(0),U) NURS=1
23 I '+NURS W !!,$C(7),?5,"NO FUNDS WERE REQUESTED FOR "_$S(X="T":"TRAVEL",X="A":"AIRFARE",X="P":"PER DIEM",1:"REGISTRATION")_":" K X
24 K NURS
25 Q
26EN4 ; PRINT ERROR MESSAGE BASED ON WHAT IS RETURNED FROM EN3
27 ; INPUT VARIABLES: NURSBAD=$S(0:NO PROB,1:PROB)^$S(1:FTEE>1,2:DUP PRI,
28 ; 3:STARTDT>VACDT,4:DUP)
29 ; SERVICE POS,5:NO PRI)
30 ; ASS:ERR,7:DUP DUTY
31 ; TOURS)
32 I NURSBAD W !!?5,$C(7) W:'($P(NURSBAD,U,2)=5) "DUE TO CHANGES THAT HAVE BEEN MADE, "
33 I W $S($P(NURSBAD,U,2)=1:"THE TOTAL FTEE",$P(NURSBAD,U,2)=2:"TWO PRIMARY ASSIGNMENTS EXIST FOR",$P(NURSBAD,U,2)=3:"THE START DATE IS GREATER THAN",$P(NURSBAD,U,2)=4:"DUPLICATE SERVICE POSITIONS ON THE",1:"")
34 I W $S($P(NURSBAD,U,2)=7:"DUPLICATE DUTY TOURS ON THE",1:"")
35 I W $S($P(NURSBAD,U,2)=1:"",$P(NURSBAD,U,2)=2:"",$P(NURSBAD,U,2)=3:"",$P(NURSBAD,U,2)=4:"",$P(NURSBAD,U,2)=5:"NO PRIMARY POSITION WAS DESIGNATED, THIS POSITION WILL BE PRIMARY",$P(NURSBAD,U,2)=7:"",1:"")
36 I W $S($P(NURSBAD,U,2)=1:"",$P(NURSBAD,U,2)=2:"",$P(NURSBAD,U,2)=3:"",$P(NURSBAD,U,2)=4:"",$P(NURSBAD,U,2)=5:"",$P(NURSBAD,U,2)=6:"NO PRIMARY POSITION EXISTS FOR THIS ",$P(NURSBAD,U,2)=7:"",1:"INVALID DATA EXISTS FOR THIS")
37 I W !?5,$S($P(NURSBAD,U,2)=1:"WOULD BE GREATER THAN 1 FOR THIS ",$P(NURSBAD,U,2)=2:"THIS ",$P(NURSBAD,U,2)=3:"THE VACANCY DATE FOR THIS ",$P(NURSBAD,U,2)=4!($P(NURSBAD,U,2)=7):"SAME LOCATION EXIST FOR THIS ",1:"")
38 I W:'($P(NURSBAD,U,2)=5) "EMPLOYEE. PLEASE RETRY THE CHANGE.",!
39 K NURSBAD,NX
40 Q
41EN5 ; ENTRY FROM INPUT TRANSFORM FOR 2 & 3 SUBFIELDS OF FIELD 24
42 ; OF FILE 210
43 S NURS(0)=$S($D(^NURSF(210,DA(1),12,DA,0)):^(0),1:""),NURS("HELP")="DATE MUST BE "_$P("GREATER THAN DATE STARTED ^LESS THAN DATE ENDED ",U,NURS*10=20+1),%DT(0)=+($E("-",NURS*10=20)_$P(NURS(0),U,$E(23,NURS*10=20+1)))
44 S:%DT(0)=0 %DT(0)=2500101 ;this check stops erroneous years from being entered if user responds with 010100 and FileMan returns 1/1/1900
45 K:%DT(0)=0 %DT(0) S %DT="E" D ^%DT S X=Y I Y<1 W !?5,NURS("HELP") K X
46 K %DT,NURS
47 Q
48EN6(DA) ; SCREEN IF EMPLOYEE IS AUTHORIZED TO VIEW THIS LOCATION
49 ; VARIABLES ARE SET BASED ON DIC("S") TO FILE 210.
50 ;
51 S NURSZORT=1
52 N NURNODE4,NUR200DA,NUR21182,NURDATA,NURSSEE
53 S NUR200DA=+$G(^NURSF(210,+Y,0)) I NUR200DA'>0 S NURSZORT=0
54 I NURSZORT D
55 . I $G(NURSZAP)>6 D Q:'NURSZORT ; Check location security.
56 . . S NURSZORT=0
57 . . S NURNODE4=0 F S NURNODE4=$O(^NURSF(211.8,"C",NUR200DA,NURNODE4)) Q:NURNODE4'>0 D Q:NURSZORT
58 . . . S NUR21182=0 F S NUR21182=$O(^NURSF(211.8,"C",NUR200DA,NURNODE4,NUR21182)) Q:NUR21182'>0 D Q:NURSZORT
59 . . . . S NURDATA=$G(^NURSF(211.8,NURNODE4,1,NUR21182,0)) Q:NURDATA=""
60 . . . . Q:$P(NURDATA,U)=""!($P(NURDATA,U)>DT)!($P(NURDATA,U,6)'=""&($P(NURDATA,U,6)'>DT))
61 . . . . S NURSZORT=1 D EN3^NURSAUTL
62 . . . . Q
63 . . . Q
64 . . Q
65 . D EN2^NURSAUTL:$G(NURSZAP) ; Check service position security.
66 . Q
67 Q +$G(NURSZORT)
68 ;
69EN7(DUZ) ; PRSE TRAIN SECURITY KEY CHECK
70 Q $S($D(^XUSEC("PRSE TRAIN",DUZ)):1,1:0)
71EN8(DUZ) ; PRSE SUP SECURITY KEY CHECK
72 Q $S($D(^XUSEC("PRSE SUP",DUZ)):1,1:0)
73EN9(DUZ) ; PRSE CORD SECURITY KEY CHECK
74 Q $S($D(^XUSEC("PRSE CORD",DUZ)):1,1:0)
75EN10(DUZ) ;
76 I NURSZAP>0,+$$EN8^NURSUT3($G(DUZ)) S NURSZAP=0 Q
77 I NURSZAP>0,+$$EN9^NURSUT3($G(DUZ)) S NURSZAP=0 Q
78 I NURSZAP>7,+$$EN7^NURSUT3($G(DUZ)) S NURSZAP=7
79 Q
80EN11(DA) ; GET FACILITY WITH POSITION CONTROL IEN IN THE NURS POSITION
81 ; CONTROL 211.8 FILE. THE VALUE OF THE FUNCTION WILL BE "" IF THERE
82 ; IS NO FACILITY ASSOCIATED WITH THIS HOSPITAL LOCATION, OR THE
83 ; FREE TEXT VALUE OF THE FACILITY
84 S XXX="",DIC44DA=+$$GET1^DIQ(211.8,DA,.01,"I")
85 I DIC44DA S DIC4DA=+$$GET1^DIQ(44,DIC44DA,3,"I") I DIC4DA S XXX=$$GET1^DIQ(4,+DIC4DA,.01,"I")
86 S:XXX="" XXX=$S($G(NURMDSW):" BLANK",$G(^NURSA(213.2,1,0)):$$GET1^DIQ(4,+$G(^NURSA(213.2,1,0)),.01,"I"),1:"")
87 K DIC44DA,DIC4DA
88 Q XXX
89EN12(DA) ; GET FACILITY WITH IEN FROM THE NURS LOCATION 211.4 FILE
90 ; THE VALUE OF THE FUNCTION WILL BE " BLANK" IF THERE IS NO FACILITY ASSOCIATED
91 ; WITH THIS NURS LOCATION OR THE FREE TEXT VALUE OF THE FACILITY
92 S XXX="",DIC4DA=+$P($G(^SC(+$G(^NURSF(211.4,+DA,0)),0)),U,4),XXX=$$GET1^DIQ(4,+DIC4DA,.01,"I") S:XXX="" XXX=" BLANK" K DIC4DA
93 Q XXX
94EN13(NOD1) ; GET PRODUCT LINE OF PRIMARY NURS LOCATIO WITH IEN FROM THE
95 ; POSITION CONTROL FILE THE VALUE OF THE FUNCTION WILL BE " BLANK
96 ; IF THERE IS NO PRODUCT LINE ASSOCIATED WITH THIS NURS LOCATION OR THE
97 ; FREE TEXT VALUE OF THE PRODUCT LINE
98 N NURUNIT,SC44DA,NUR2127 S SC44DA=+$G(^NURSF(211.8,NOD1,0)),NURUNIT=$O(^NURSF(211.4,"B",SC44DA,0))
99 S XXX=" BLANK",NUR2127=+$P($G(^NURSF(211.4,+NURUNIT,1)),U,4) I NUR2127 S XXX=$$GET1^DIQ(212.7,+NUR2127,.01,"I")
100 Q XXX
101GETSER() ; THIS PROCEDURE WILL RETURN THE VALUE FOR NURSING IN THE
102 ; PAID COST CENTER ORGANIZATION CODE (454.1) FILE. THE VALUE
103 ; OF THE FUNCTION WILL BE "" IF THERE ARE NO NURSING ENTRIES, OR
104 ; A LIST OF NURSING ENTRY IEN's SEPARATED BY ^'s.
105 N FXN
106 S FXN(1)=$O(^PRSP(454.1,"B","NURSING",0))
107 S FXN(2)=$O(^PRSP(454.1,"B","NURSING SERVICE",0))
108 I FXN(1)!FXN(2) S FXN=U_$S(FXN(1):FXN(1)_U,1:"")_$S(FXN(2):FXN(2)_U,1:"")
109 E S FXN=""
110 Q FXN
Note: See TracBrowser for help on using the repository browser.