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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSAUTL 3740 printed Dec 13, 2024@02:21:38 Page 2
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
