source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSAUTL.m@ 949

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1NURSAUTL ;HIRMFO/MD/JH-SECURITY ROUTINE FOR THE NURSING ADMIN REPORTS ;9/7/90 12:59
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ; SET SECURITY ACCESS LEVEL FOR ADMIN REPORTS
4 I $S('$D(^VA(200,+DUZ,0)):1,1:0) W !,$C(7),"**** INCOMPLETE NEW PERSON DATA -- NOTIFY NURSING ADP COORDINATOR **** " S NUROUT=1 Q
5 S (NURMDSW,NURPLSW)=0 D EN9^NURSAGSP
6 S NURSZDA=+$O(^NURSF(210,"B",DUZ,"")) I DUZ(0)["n"!(DUZ(0)="@") S NURSZAP=0,NURSZSP=0 Q
7 I '$D(^NURSF(210,+NURSZDA,0)) G INCOMPL
8 S DA=NURSZDA D EN3^NURSUT0 G:NOD1="" INCOMPL
9 I $S('$D(^NURSF(211.8,NOD1,0)):1,'$O(^NURSF(211.4,"B",+$P(^NURSF(211.8,NOD1,0),"^"),"")):1,$P(^NURSF(211.8,NOD1,1,NOD2,0),"^",3)'="":0,1:1) G INCOMPL
10 S NURSZSP=$P(^NURSF(211.8,NOD1,1,NOD2,0),"^",3)
11 F X=0:0 S X=$O(^NURSF(211.8,"C",DUZ,X)) Q:X'>0 F Z=0:0 S Z=$O(^NURSF(211.8,"C",DUZ,X,Z)) Q:Z'>0 I '($P(^NURSF(211.8,X,1,Z,0),U)>DT),('$P(^(0),U,6)!($P(^(0),U,6)'<DT)) D
12 . S NURSZLO($O(^NURSF(211.4,"B",+$P(^NURSF(211.8,X,0),"^"),"")))="" S NURSFAC=$$EN11^NURSUT3($G(X)) S:$G(NURSFAC)'="" NURSZFAC(NURSFAC)=""
13 . Q
14 K X,NOD1,NOD2 I $S('$D(^NURSF(211.3,NURSZSP,0)):1,$P(^(0),"^",5)'="":0,1:1) D BADSER Q
15 I $P(^NURSF(211.3,NURSZSP,0),"^",5)'="R" S NURSZAP=16 Q
16 I $S($P(^NURSF(211.3,NURSZSP,0),"^",4)="":1,'$D(^NURSF(211.7,$P(^NURSF(211.3,NURSZSP,0),"^",4),0)):1,+$P(^(0),"^",3):0,1:1) D BADSER Q
17 S NURSZAP=$P(^NURSF(211.7,$P(^NURSF(211.3,NURSZSP,0),"^",4),0),"^",3)
18 Q
19BADSER W !,$C(7),"**** INCOMPLETE SERVICE POSITION DATA -- NOTIFY ADP COORDINATOR ****" S NUROUT=1 Q
20INCOMPL W !,$C(7),"**** INCOMPLETE NURSING DATA -- NOTIFY NURSING ADP COORDINATOR ****" S NUROUT=1 Q
21EN2 ; SET SECURITY LEVEL BASED ON SERVICE POSITION
22 Q:NURSZDA=DA
23 I NURSZAP>7,NURSZDA'=DA S NURSZORT=0 Q
24 D EN2^NURSUT0 S NURSZSP=NPSPOS(0) I $S(NURSZSP="":1,$D(^NURSF(211.3,NURSZSP,0)):0,1:1) S NURSZORT=0 D Q2 Q
25 S NURSYAP=$S($P(^NURSF(211.3,NURSZSP,0),"^",5)'="R":16,$P(^(0),"^",4)="":"",$D(^NURSF(211.7,$P(^NURSF(211.3,NURSZSP,0),"^",4),0)):$P(^(0),"^",3),1:"")
26 I $S(NURSYAP="":1,NURSYAP'<NURSZAP:0,1:1) S NURSZORT=0
27Q2 K NPSPOS(0),NURSZSP,NURSYAP
28 Q
29EN3 ; SELECT LOCATIONS TO ACCESSED BASED ON SECURITY LEVEL
30 Q:NURSZDA=DA
31 S NURSYLO=$S('$D(^NURSF(211.8,NURNODE4,0)):"",1:$O(^NURSF(211.4,"B",+$P(^NURSF(211.8,NURNODE4,0),"^"),""))) I $S(NURSYLO="":1,$D(NURSZLO(NURSYLO)):0,1:1) S NURSZORT=0
32 K NURSYLO
33 Q
34EN4 ; SCREEN OUT ACCESS FOR UNAUTHORIZED LOCATIONS
35 S X="" F Y=0:0 S X=$O(^TMP($J,X)) Q:X="" S Z="" F Y=0:0 S Z=$O(^SC("B",$S(X'?1"NUR ":"NUR ",1:"")_X,Z)) Q:Z'>0 S Y=$O(^NURSF(211.4,"B",Z,"")) K:$S(Y'>0:0,'$D(NURSZLO(Y)):1,1:0) ^TMP($J,X)
36 K X,Y Q
37EN5 ;ENTRY FROM NURS-P-STAFF TO CHECK MILITARY STATUS
38 W ! S D1=0 F S D1=$O(^NURSF(210,D0,10,D1)) Q:D1'>0 D
39 . S NDATA=$G(^NURSF(210,D0,10,D1,0))
40 . I $P(NDATA,U)'="" W !,?6,"MILITARY EXPERIENCE: ",$S($P(NDATA,U)="R":"(RETIRED/DISC)",$P(NDATA,U)="A":"(ACT RESV)",$P(NDATA,U)="IRR":"(IND RDY RESV)",$P(NDATA,U)="IMA":"(IND MOBIL AUGM)",1:"")
41 . I $P(NDATA,U,2)'="" W ?44,"BRANCH OF SERVICE: ",$E($P(^DIC(23,+$P(NDATA,U,2),0),U),1,20)
42 . Q
43 Q
44EN6 ; ENTRY FROM NURSING ROUTINES TO CONVERT PTR TO 211.4 FILE TO
45 ; DATA STORED IN 44 FILE. NPWARD COMES IN AS PTR AND LEAVES
46 ; AS FREE TEXT OR NULL.
47 S:'$D(NPWARD) NPWARD=""
48 S NPWARD=$S(NPWARD="":"",'$D(^NURSF(211.4,NPWARD,0)):"",$P(^(0),"^")="":"",$D(^SC($P(^NURSF(211.4,NPWARD,0),"^"),0)):$P(^(0),"^"),1:"")
49 S NPWARD=$S(NPWARD?1"NUR ".E:$P(NPWARD,"NUR ",2),1:NPWARD)
50 Q
51EN7 ; ENTRY FROM NURSING ROUTINES TO CONVERT PTR TO 211.8 FILE TO DATA
52 ; STORED IN 44 FILE. NPWARD COMES IN AS PTR AND LEAVES AS FREE
53 ; TEXT OR NULL.
54 S:'$D(NPWARD) NPWARD=""
55 S NPWARD=$S(NPWARD="":"",$D(^SC(NPWARD,0)):$P(^(0),"^"),1:"")
56 S NPWARD=$S(NPWARD?1"NUR ".E:$P(NPWARD,"NUR ",2),1:NPWARD)
57 Q
Note: See TracBrowser for help on using the repository browser.