- NURSAUTL ;HIRMFO/MD/JH-SECURITY ROUTINE FOR THE NURSING ADMIN REPORTS ;9/7/90 12:59
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ; SET SECURITY ACCESS LEVEL FOR ADMIN REPORTS
- 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
- S (NURMDSW,NURPLSW)=0 D EN9^NURSAGSP
- S NURSZDA=+$O(^NURSF(210,"B",DUZ,"")) I DUZ(0)["n"!(DUZ(0)="@") S NURSZAP=0,NURSZSP=0 Q
- I '$D(^NURSF(210,+NURSZDA,0)) G INCOMPL
- S DA=NURSZDA D EN3^NURSUT0 G:NOD1="" INCOMPL
- 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
- S NURSZSP=$P(^NURSF(211.8,NOD1,1,NOD2,0),"^",3)
- 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
- . S NURSZLO($O(^NURSF(211.4,"B",+$P(^NURSF(211.8,X,0),"^"),"")))="" S NURSFAC=$$EN11^NURSUT3($G(X)) S:$G(NURSFAC)'="" NURSZFAC(NURSFAC)=""
- . Q
- K X,NOD1,NOD2 I $S('$D(^NURSF(211.3,NURSZSP,0)):1,$P(^(0),"^",5)'="":0,1:1) D BADSER Q
- I $P(^NURSF(211.3,NURSZSP,0),"^",5)'="R" S NURSZAP=16 Q
- 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
- S NURSZAP=$P(^NURSF(211.7,$P(^NURSF(211.3,NURSZSP,0),"^",4),0),"^",3)
- Q
- BADSER W !,$C(7),"**** INCOMPLETE SERVICE POSITION DATA -- NOTIFY ADP COORDINATOR ****" S NUROUT=1 Q
- INCOMPL W !,$C(7),"**** INCOMPLETE NURSING DATA -- NOTIFY NURSING ADP COORDINATOR ****" S NUROUT=1 Q
- EN2 ; SET SECURITY LEVEL BASED ON SERVICE POSITION
- Q:NURSZDA=DA
- I NURSZAP>7,NURSZDA'=DA S NURSZORT=0 Q
- 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
- 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:"")
- I $S(NURSYAP="":1,NURSYAP'<NURSZAP:0,1:1) S NURSZORT=0
- Q2 K NPSPOS(0),NURSZSP,NURSYAP
- Q
- EN3 ; SELECT LOCATIONS TO ACCESSED BASED ON SECURITY LEVEL
- Q:NURSZDA=DA
- 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
- K NURSYLO
- Q
- EN4 ; SCREEN OUT ACCESS FOR UNAUTHORIZED LOCATIONS
- 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)
- K X,Y Q
- EN5 ;ENTRY FROM NURS-P-STAFF TO CHECK MILITARY STATUS
- W ! S D1=0 F S D1=$O(^NURSF(210,D0,10,D1)) Q:D1'>0 D
- . S NDATA=$G(^NURSF(210,D0,10,D1,0))
- . 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:"")
- . I $P(NDATA,U,2)'="" W ?44,"BRANCH OF SERVICE: ",$E($P(^DIC(23,+$P(NDATA,U,2),0),U),1,20)
- . Q
- Q
- EN6 ; ENTRY FROM NURSING ROUTINES TO CONVERT PTR TO 211.4 FILE TO
- ; DATA STORED IN 44 FILE. NPWARD COMES IN AS PTR AND LEAVES
- ; AS FREE TEXT OR NULL.
- S:'$D(NPWARD) NPWARD=""
- S NPWARD=$S(NPWARD="":"",'$D(^NURSF(211.4,NPWARD,0)):"",$P(^(0),"^")="":"",$D(^SC($P(^NURSF(211.4,NPWARD,0),"^"),0)):$P(^(0),"^"),1:"")
- S NPWARD=$S(NPWARD?1"NUR ".E:$P(NPWARD,"NUR ",2),1:NPWARD)
- Q
- EN7 ; ENTRY FROM NURSING ROUTINES TO CONVERT PTR TO 211.8 FILE TO DATA
- ; STORED IN 44 FILE. NPWARD COMES IN AS PTR AND LEAVES AS FREE
- ; TEXT OR NULL.
- S:'$D(NPWARD) NPWARD=""
- S NPWARD=$S(NPWARD="":"",$D(^SC(NPWARD,0)):$P(^(0),"^"),1:"")
- S NPWARD=$S(NPWARD?1"NUR ".E:$P(NPWARD,"NUR ",2),1:NPWARD)
- Q
- NURSAUTL ;HIRMFO/MD/JH-SECURITY ROUTINE FOR THE NURSING ADMIN REPORTS ;9/7/90 12:59
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ; SET SECURITY ACCESS LEVEL FOR ADMIN REPORTS
- +1 IF $SELECT('$DATA(^VA(200,+DUZ,0)):1,1:0)
- WRITE !,$CHAR(7),"**** INCOMPLETE NEW PERSON DATA -- NOTIFY NURSING ADP COORDINATOR **** "
- SET NUROUT=1
- QUIT
- +2 SET (NURMDSW,NURPLSW)=0
- DO EN9^NURSAGSP
- +3 SET NURSZDA=+$ORDER(^NURSF(210,"B",DUZ,""))
- IF DUZ(0)["n"!(DUZ(0)="@")
- SET NURSZAP=0
- SET NURSZSP=0
- QUIT
- +4 IF '$DATA(^NURSF(210,+NURSZDA,0))
- GOTO INCOMPL
- +5 SET DA=NURSZDA
- DO EN3^NURSUT0
- IF NOD1=""
- GOTO INCOMPL
- +6 IF $SELECT('$DATA(^NURSF(211.8,NOD1,0)):1,'$ORDER(^NURSF(211.4,"B",+$PIECE(^NURSF(211.8,NOD1,0),"^"),"")):1,$PIECE(^NURSF(211.8,NOD1,1,NOD2,0),"^",3)'="":0,1:1)
- GOTO INCOMPL
- +7 SET NURSZSP=$PIECE(^NURSF(211.8,NOD1,1,NOD2,0),"^",3)
- +8 FOR X=0:0
- SET X=$ORDER(^NURSF(211.8,"C",DUZ,X))
- IF X'>0
- QUIT
- FOR Z=0:0
- SET Z=$ORDER(^NURSF(211.8,"C",DUZ,X,Z))
- IF Z'>0
- QUIT
- IF '($PIECE(^NURSF(211.8,X,1,Z,0),U)>DT)
- IF ('$PIECE(^(0),U,6)!($PIECE(^(0),U,6)'<DT))
- Begin DoDot:1
- +9 SET NURSZLO($ORDER(^NURSF(211.4,"B",+$PIECE(^NURSF(211.8,X,0),"^"),"")))=""
- SET NURSFAC=$$EN11^NURSUT3($GET(X))
- IF $GET(NURSFAC)'=""
- SET NURSZFAC(NURSFAC)=""
- +10 QUIT
- End DoDot:1
- +11 KILL X,NOD1,NOD2
- IF $SELECT('$DATA(^NURSF(211.3,NURSZSP,0)):1,$PIECE(^(0),"^",5)'="":0,1:1)
- DO BADSER
- QUIT
- +12 IF $PIECE(^NURSF(211.3,NURSZSP,0),"^",5)'="R"
- SET NURSZAP=16
- QUIT
- +13 IF $SELECT($PIECE(^NURSF(211.3,NURSZSP,0),"^",4)="":1,'$DATA(^NURSF(211.7,$PIECE(^NURSF(211.3,NURSZSP,0),"^",4),0)):1,+$PIECE(^(0),"^",3):0,1:1)
- DO BADSER
- QUIT
- +14 SET NURSZAP=$PIECE(^NURSF(211.7,$PIECE(^NURSF(211.3,NURSZSP,0),"^",4),0),"^",3)
- +15 QUIT
- BADSER WRITE !,$CHAR(7),"**** INCOMPLETE SERVICE POSITION DATA -- NOTIFY ADP COORDINATOR ****"
- SET NUROUT=1
- QUIT
- INCOMPL WRITE !,$CHAR(7),"**** INCOMPLETE NURSING DATA -- NOTIFY NURSING ADP COORDINATOR ****"
- SET NUROUT=1
- QUIT
- EN2 ; SET SECURITY LEVEL BASED ON SERVICE POSITION
- +1 IF NURSZDA=DA
- QUIT
- +2 IF NURSZAP>7
- IF NURSZDA'=DA
- SET NURSZORT=0
- QUIT
- +3 DO EN2^NURSUT0
- SET NURSZSP=NPSPOS(0)
- IF $SELECT(NURSZSP="":1,$DATA(^NURSF(211.3,NURSZSP,0)):0,1:1)
- SET NURSZORT=0
- DO Q2
- QUIT
- +4 SET NURSYAP=$SELECT($PIECE(^NURSF(211.3,NURSZSP,0),"^",5)'="R":16,$PIECE(^(0),"^",4)="":"",$DATA(^NURSF(211.7,$PIECE(^NURSF(211.3,NURSZSP,0),"^",4),0)):$PIECE(^(0),"^",3),1:"")
- +5 IF $SELECT(NURSYAP="":1,NURSYAP'<NURSZAP:0,1:1)
- SET NURSZORT=0
- Q2 KILL NPSPOS(0),NURSZSP,NURSYAP
- +1 QUIT
- EN3 ; SELECT LOCATIONS TO ACCESSED BASED ON SECURITY LEVEL
- +1 IF NURSZDA=DA
- QUIT
- +2 SET NURSYLO=$SELECT('$DATA(^NURSF(211.8,NURNODE4,0)):"",1:$ORDER(^NURSF(211.4,"B",+$PIECE(^NURSF(211.8,NURNODE4,0),"^"),"")))
- IF $SELECT(NURSYLO="":1,$DATA(NURSZLO(NURSYLO)):0,1:1)
- SET NURSZORT=0
- +3 KILL NURSYLO
- +4 QUIT
- EN4 ; SCREEN OUT ACCESS FOR UNAUTHORIZED LOCATIONS
- +1 SET X=""
- FOR Y=0:0
- SET X=$ORDER(^TMP($JOB,X))
- IF X=""
- QUIT
- SET Z=""
- FOR Y=0:0
- SET Z=$ORDER(^SC("B",$SELECT(X'?1"NUR ":"NUR ",1:"")_X,Z))
- IF Z'>0
- QUIT
- SET Y=$ORDER(^NURSF(211.4,"B",Z,""))
- IF $SELECT(Y'>0
- KILL ^TMP($JOB,X)
- +2 KILL X,Y
- QUIT
- EN5 ;ENTRY FROM NURS-P-STAFF TO CHECK MILITARY STATUS
- +1 WRITE !
- SET D1=0
- FOR
- SET D1=$ORDER(^NURSF(210,D0,10,D1))
- IF D1'>0
- QUIT
- Begin DoDot:1
- +2 SET NDATA=$GET(^NURSF(210,D0,10,D1,0))
- +3 IF $PIECE(NDATA,U)'=""
- WRITE !,?6,"MILITARY EXPERIENCE: ",$SELECT($PIECE(NDATA,U)="R":"(RETIRED/DISC)",$PIECE(NDATA,U)="A":"(ACT RESV)",$PIECE(NDATA,U)="IRR":"(IND RDY RESV)",$PIECE(NDATA,U)="IMA":"(IND MOBIL AUGM)",1:"")
- +4 IF $PIECE(NDATA,U,2)'=""
- WRITE ?44,"BRANCH OF SERVICE: ",$EXTRACT($PIECE(^DIC(23,+$PIECE(NDATA,U,2),0),U),1,20)
- +5 QUIT
- End DoDot:1
- +6 QUIT
- EN6 ; ENTRY FROM NURSING ROUTINES TO CONVERT PTR TO 211.4 FILE TO
- +1 ; DATA STORED IN 44 FILE. NPWARD COMES IN AS PTR AND LEAVES
- +2 ; AS FREE TEXT OR NULL.
- +3 IF '$DATA(NPWARD)
- SET NPWARD=""
- +4 SET NPWARD=$SELECT(NPWARD="":"",'$DATA(^NURSF(211.4,NPWARD,0)):"",$PIECE(^(0),"^")="":"",$DATA(^SC($PIECE(^NURSF(211.4,NPWARD,0),"^"),0)):$PIECE(^(0),"^"),1:"")
- +5 SET NPWARD=$SELECT(NPWARD?1"NUR ".E:$PIECE(NPWARD,"NUR ",2),1:NPWARD)
- +6 QUIT
- EN7 ; ENTRY FROM NURSING ROUTINES TO CONVERT PTR TO 211.8 FILE TO DATA
- +1 ; STORED IN 44 FILE. NPWARD COMES IN AS PTR AND LEAVES AS FREE
- +2 ; TEXT OR NULL.
- +3 IF '$DATA(NPWARD)
- SET NPWARD=""
- +4 SET NPWARD=$SELECT(NPWARD="":"",$DATA(^SC(NPWARD,0)):$PIECE(^(0),"^"),1:"")
- +5 SET NPWARD=$SELECT(NPWARD?1"NUR ".E:$PIECE(NPWARD,"NUR ",2),1:NPWARD)
- +6 QUIT
