NURAAGS1 ;HIRMFO/RM,MD-MULTIDIVISIONAL GENERIC SORT ROUTINE FOR ADMIN REPORTS ;5/2/97
;;4.0;NURSING SERVICE;**1**;Apr 25, 1997
SETCAT ; SET CATEGORY VARIABLE NURSCATY
N X,Y
S X=$P($G(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),U,3),Y=$G(^NURSF(211.3,+X,0))
I Y'="" S NURSCATY=$P(Y,U,5) S:NURSCATY="O" NURSCATY=NURSCATY_" "_$$UP^XLFSTR($P(Y,U,6))
E S NURSCATY=" BLANK"
Q
SETLOC ; SET LOCATION VARIABLE NLOCN
S NLOCN=$S($D(^NURSF(211.8,NURNODE4,0)):$P(^(0),U),1:"")
I +NLOCN S NPWARD=NLOCN D EN7^NURSAUTL S NLOCN(1)=$S(NPWARD'="":$E(NPWARD,1,10),1:" BLANK")
Q
SETPOS ; SET SERVICE POSITION AND PRIORITY SEQUENCE VARIABLES NSPOSN,NPRI
I $D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),$P(^(0),U,3)'="",$D(^NURSF(211.3,$P(^NURSF(211.8,NURNODE4,1,NURNODE5,0),U,3),0)) G C
E S (NSPOSN,NPRI)=" BLANK" Q
C I $P(^NURSF(211.3,$P(^NURSF(211.8,NURNODE4,1,NURNODE5,0),U,3),0),U,1)'="" S NSPOSN=$P(^(0),U,1)
E S NSPOSN=" BLANK"
I $P(^NURSF(211.3,$P(^NURSF(211.8,NURNODE4,1,NURNODE5,0),U,3),0),U,3)'="" S NPRI=$P(^(0),U,3)
E S NPRI=" BLANK"
Q
SETFAC ; SET FACILITY VARIBLE NURFAC(2)
I $G(NURMDSW) S NURFAC(2)=$$EN11^NURSUT3($G(NURNODE4)) S:NURFAC(2)="" NURFAC(2)=" BLANK"
E S NURFAC(2)=" BLANK"
Q
SETPROG ; SET PRODUCT LINE VARIBLE NURPROG(2)
I $G(NURPLSW) D
. I NURNEN=3!(NURNEN=4) D
. . S NURPROG(2)=$O(^NURSF(211.4,"B",+$P(^NURSF(211.8,NURNODE4,0),U),""))
. . S NURPROG(2)=+$P($G(^NURSF(211.4,+NURPROG(2),1)),U,4)
. . Q
. I NURNEN=1!(NURNEN=2) D
. . S NURPROG(2)=$P($G(^NURSF(211.8,+NURNODE4,1,+NURNODE5,0)),U,3)
. . S NURPROG(2)=+$P($G(^NURSF(211.3,+NURPROG(2),0)),U,7)
. . Q
. S:NURPROG(2)="" NURPROG(2)=+$O(^NURSF(212.7,"B","NURSING",0))
. S NURPROG(2)=$$GET1^DIQ(212.7,+NURPROG(2),.01,"I")
. S:NURPROG(2)="" NURPROG(2)=" BLANK"
. Q
E S NURPROG(2)=" BLANK"
Q
SETCERT ; SET ^TMP($J FOR CERTIFICATION REPORTS
S DATA=+$P($G(^NURSF(210,DA,12,D0,0)),U) I DATA>0,$P($G(^NURSF(212.2,+DATA,0)),U,2)'="" S NSPEC(1)=$P(^(0),U,2)
E S NSPEC(1)=" BLANK"
I $P($G(^NURSF(210,DA,12,D0,0)),U,4)'="" S NSPEC=$P(^(0),U,4)
E S NSPEC=" BLANK"
I 'NSP,NSPC'=NSPEC(1) Q
I 'NSP(1),NSPEC>NSPC(2)!(NSPEC<NSPC(1)) Q
I NSPEC(1)'=" BLANK" D SETUTIL
Q
SETMIL ; SET ^TMP($J FOR MILITARY REPORTS
I $D(^NURSF(210,DA,10,D0,0)),$P(^(0),U,1)'="" S NSPEC(1)=$P(^(0),U,1)
E S NSPEC(1)=" BLANK"
I $D(^NURSF(210,DA,10,D0,0)),$P(^(0),U,2)'="",$D(^DIC(23,$P(^NURSF(210,DA,10,D0,0),U,2),0)),$P(^(0),U,1)'="" S NSPEC=$P(^(0),U,1)
E S NSPEC=" BLANK"
I 'NSP,NSPC'=NSPEC(1) Q
I 'NSP(1),NSPC(1)'=NSPEC Q
D SETUTIL
Q
SETUTIL ;
W:$E(IOST)="C"&($R(100)) "."
I NURPLSW S NURPROG(3)=+$O(^NURSF(212.7,"B","NURSING",0)),NURPROG(3)=$$GET1^DIQ(212.7,NURPROG(3),.01,"I") S:NURPROG(2)=NURPROG(3) NURPROG(2)=" "_NURPROG(2)
I NURNEN=1 S:$G(NURSORT)="" NURSORT=1 D
. N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC(1),NSPEC))
. I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP($J,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC(1),NSPEC)=X
. S ^TMP($J,"L1",X,NNM,DA,NURNODE4,NURNODE5)=""
. Q
I NURNEN=2 S:$G(NURSORT)="" NURSORT=1 D
. N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC(1)))
. I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP($J,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC(1))=X
. S ^TMP($J,"L1",X,NSPEC,NNM,DA,NURNODE4,NURNODE5)=""
. Q
I NURNEN=3 S:$G(NURSORT)="" NURSORT=1 D
. N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC(1)))
. I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC(1))=X
. S ^TMP($J,"L1",X,NSPEC,NNM,DA,NURNODE4,NURNODE5)=""
. Q
I NURNEN=4 S:$G(NURSORT)="" NURSORT=1 D
. N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN))
. I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN)=X
. S ^TMP($J,"L1",X,NSPEC(1),NSPEC,NNM,DA,NURNODE4,NURNODE5)=""
. Q
Q
SETLIC ; SET VARIABLES FOR LICENSE REPORTS
I $D(^NURSF(210,DA,4,D0,0)),$P(^(0),U,3)'="" S NSPEC=$P(^(0),U,3)_D0
E S NSPEC=" BLANK"_D0
Q
SETUPTL ; BUILD TMP ARRAY
W:$E(IOST)="C"&($R(100)) "."
I NURPLSW S NURPROG(3)=+$O(^NURSF(212.7,"B","NURSING",0)),NURPROG(3)=$$GET1^DIQ(212.7,NURPROG(3),.01,"I") S:NURPROG(2)=NURPROG(3) NURPROG(2)=" "_NURPROG(2)
I NURNEN=1 S:$G(NURSORT)="" NURSORT=1 D
. N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC,NNM))
. I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP($J,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC,NNM)=X
. S ^TMP($J,"L1",X,DA,NURNODE4,NURNODE5)=""
. Q
I NURNEN=2 S:$G(NURSORT)="" NURSORT=1 D
. N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC))
. I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP($J,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC)=X
. S ^TMP($J,"L1",X,NNM,DA,NURNODE4)=""
. Q
I NURNEN=3 S:$G(NURSORT)="" NURSORT=1 D
. N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC))
. I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC)=X
. S ^TMP($J,"L1",X,NNM,DA,NURNODE4,NURNODE5)=""
. Q
I NURNEN=4 S:$G(NURSORT)="" NURSORT=1 D
. N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN))
. I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN)=X
. S ^TMP($J,"L1",X,NSPEC,NNM,DA,NURNODE4)=""
. Q
Q
CHKPOS ; SELECT ACTIVE POSITIONS
S NURNEN(1)=0 I $P(^NURSF(211.8,NURNODE4,1,NURNODE5,0),U)'>DT&('$P(^(0),U,6)!($P(^(0),U,6)'<DT)) S NURNEN(1)=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAAGS1 5506 printed Oct 16, 2024@18:19:31 Page 2
NURAAGS1 ;HIRMFO/RM,MD-MULTIDIVISIONAL GENERIC SORT ROUTINE FOR ADMIN REPORTS ;5/2/97
+1 ;;4.0;NURSING SERVICE;**1**;Apr 25, 1997
SETCAT ; SET CATEGORY VARIABLE NURSCATY
+1 NEW X,Y
+2 SET X=$PIECE($GET(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),U,3)
SET Y=$GET(^NURSF(211.3,+X,0))
+3 IF Y'=""
SET NURSCATY=$PIECE(Y,U,5)
if NURSCATY="O"
SET NURSCATY=NURSCATY_" "_$$UP^XLFSTR($PIECE(Y,U,6))
+4 IF '$TEST
SET NURSCATY=" BLANK"
+5 QUIT
SETLOC ; SET LOCATION VARIABLE NLOCN
+1 SET NLOCN=$SELECT($DATA(^NURSF(211.8,NURNODE4,0)):$PIECE(^(0),U),1:"")
+2 IF +NLOCN
SET NPWARD=NLOCN
DO EN7^NURSAUTL
SET NLOCN(1)=$SELECT(NPWARD'="":$EXTRACT(NPWARD,1,10),1:" BLANK")
+3 QUIT
SETPOS ; SET SERVICE POSITION AND PRIORITY SEQUENCE VARIABLES NSPOSN,NPRI
+1 IF $DATA(^NURSF(211.8,NURNODE4,1,NURNODE5,0))
IF $PIECE(^(0),U,3)'=""
IF $DATA(^NURSF(211.3,$PIECE(^NURSF(211.8,NURNODE4,1,NURNODE5,0),U,3),0))
GOTO C
+2 IF '$TEST
SET (NSPOSN,NPRI)=" BLANK"
QUIT
C IF $PIECE(^NURSF(211.3,$PIECE(^NURSF(211.8,NURNODE4,1,NURNODE5,0),U,3),0),U,1)'=""
SET NSPOSN=$PIECE(^(0),U,1)
+1 IF '$TEST
SET NSPOSN=" BLANK"
+2 IF $PIECE(^NURSF(211.3,$PIECE(^NURSF(211.8,NURNODE4,1,NURNODE5,0),U,3),0),U,3)'=""
SET NPRI=$PIECE(^(0),U,3)
+3 IF '$TEST
SET NPRI=" BLANK"
+4 QUIT
SETFAC ; SET FACILITY VARIBLE NURFAC(2)
+1 IF $GET(NURMDSW)
SET NURFAC(2)=$$EN11^NURSUT3($GET(NURNODE4))
if NURFAC(2)=""
SET NURFAC(2)=" BLANK"
+2 IF '$TEST
SET NURFAC(2)=" BLANK"
+3 QUIT
SETPROG ; SET PRODUCT LINE VARIBLE NURPROG(2)
+1 IF $GET(NURPLSW)
Begin DoDot:1
+2 IF NURNEN=3!(NURNEN=4)
Begin DoDot:2
+3 SET NURPROG(2)=$ORDER(^NURSF(211.4,"B",+$PIECE(^NURSF(211.8,NURNODE4,0),U),""))
+4 SET NURPROG(2)=+$PIECE($GET(^NURSF(211.4,+NURPROG(2),1)),U,4)
+5 QUIT
End DoDot:2
+6 IF NURNEN=1!(NURNEN=2)
Begin DoDot:2
+7 SET NURPROG(2)=$PIECE($GET(^NURSF(211.8,+NURNODE4,1,+NURNODE5,0)),U,3)
+8 SET NURPROG(2)=+$PIECE($GET(^NURSF(211.3,+NURPROG(2),0)),U,7)
+9 QUIT
End DoDot:2
+10 if NURPROG(2)=""
SET NURPROG(2)=+$ORDER(^NURSF(212.7,"B","NURSING",0))
+11 SET NURPROG(2)=$$GET1^DIQ(212.7,+NURPROG(2),.01,"I")
+12 if NURPROG(2)=""
SET NURPROG(2)=" BLANK"
+13 QUIT
End DoDot:1
+14 IF '$TEST
SET NURPROG(2)=" BLANK"
+15 QUIT
SETCERT ; SET ^TMP($J FOR CERTIFICATION REPORTS
+1 SET DATA=+$PIECE($GET(^NURSF(210,DA,12,D0,0)),U)
IF DATA>0
IF $PIECE($GET(^NURSF(212.2,+DATA,0)),U,2)'=""
SET NSPEC(1)=$PIECE(^(0),U,2)
+2 IF '$TEST
SET NSPEC(1)=" BLANK"
+3 IF $PIECE($GET(^NURSF(210,DA,12,D0,0)),U,4)'=""
SET NSPEC=$PIECE(^(0),U,4)
+4 IF '$TEST
SET NSPEC=" BLANK"
+5 IF 'NSP
IF NSPC'=NSPEC(1)
QUIT
+6 IF 'NSP(1)
IF NSPEC>NSPC(2)!(NSPEC<NSPC(1))
QUIT
+7 IF NSPEC(1)'=" BLANK"
DO SETUTIL
+8 QUIT
SETMIL ; SET ^TMP($J FOR MILITARY REPORTS
+1 IF $DATA(^NURSF(210,DA,10,D0,0))
IF $PIECE(^(0),U,1)'=""
SET NSPEC(1)=$PIECE(^(0),U,1)
+2 IF '$TEST
SET NSPEC(1)=" BLANK"
+3 IF $DATA(^NURSF(210,DA,10,D0,0))
IF $PIECE(^(0),U,2)'=""
IF $DATA(^DIC(23,$PIECE(^NURSF(210,DA,10,D0,0),U,2),0))
IF $PIECE(^(0),U,1)'=""
SET NSPEC=$PIECE(^(0),U,1)
+4 IF '$TEST
SET NSPEC=" BLANK"
+5 IF 'NSP
IF NSPC'=NSPEC(1)
QUIT
+6 IF 'NSP(1)
IF NSPC(1)'=NSPEC
QUIT
+7 DO SETUTIL
+8 QUIT
SETUTIL ;
+1 if $EXTRACT(IOST)="C"&($RANDOM(100))
WRITE "."
+2 IF NURPLSW
SET NURPROG(3)=+$ORDER(^NURSF(212.7,"B","NURSING",0))
SET NURPROG(3)=$$GET1^DIQ(212.7,NURPROG(3),.01,"I")
if NURPROG(2)=NURPROG(3)
SET NURPROG(2)=" "_NURPROG(2)
+3 IF NURNEN=1
if $GET(NURSORT)=""
SET NURSORT=1
Begin DoDot:1
+4 NEW X
SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC(1),NSPEC))
+5 IF X=""
SET X=NURSORT
SET NURSORT=NURSORT+1
SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC(1),NSPEC)=X
+6 SET ^TMP($JOB,"L1",X,NNM,DA,NURNODE4,NURNODE5)=""
+7 QUIT
End DoDot:1
+8 IF NURNEN=2
if $GET(NURSORT)=""
SET NURSORT=1
Begin DoDot:1
+9 NEW X
SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC(1)))
+10 IF X=""
SET X=NURSORT
SET NURSORT=NURSORT+1
SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC(1))=X
+11 SET ^TMP($JOB,"L1",X,NSPEC,NNM,DA,NURNODE4,NURNODE5)=""
+12 QUIT
End DoDot:1
+13 IF NURNEN=3
if $GET(NURSORT)=""
SET NURSORT=1
Begin DoDot:1
+14 NEW X
SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC(1)))
+15 IF X=""
SET X=NURSORT
SET NURSORT=NURSORT+1
SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC(1))=X
+16 SET ^TMP($JOB,"L1",X,NSPEC,NNM,DA,NURNODE4,NURNODE5)=""
+17 QUIT
End DoDot:1
+18 IF NURNEN=4
if $GET(NURSORT)=""
SET NURSORT=1
Begin DoDot:1
+19 NEW X
SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN))
+20 IF X=""
SET X=NURSORT
SET NURSORT=NURSORT+1
SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN)=X
+21 SET ^TMP($JOB,"L1",X,NSPEC(1),NSPEC,NNM,DA,NURNODE4,NURNODE5)=""
+22 QUIT
End DoDot:1
+23 QUIT
SETLIC ; SET VARIABLES FOR LICENSE REPORTS
+1 IF $DATA(^NURSF(210,DA,4,D0,0))
IF $PIECE(^(0),U,3)'=""
SET NSPEC=$PIECE(^(0),U,3)_D0
+2 IF '$TEST
SET NSPEC=" BLANK"_D0
+3 QUIT
SETUPTL ; BUILD TMP ARRAY
+1 if $EXTRACT(IOST)="C"&($RANDOM(100))
WRITE "."
+2 IF NURPLSW
SET NURPROG(3)=+$ORDER(^NURSF(212.7,"B","NURSING",0))
SET NURPROG(3)=$$GET1^DIQ(212.7,NURPROG(3),.01,"I")
if NURPROG(2)=NURPROG(3)
SET NURPROG(2)=" "_NURPROG(2)
+3 IF NURNEN=1
if $GET(NURSORT)=""
SET NURSORT=1
Begin DoDot:1
+4 NEW X
SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC,NNM))
+5 IF X=""
SET X=NURSORT
SET NURSORT=NURSORT+1
SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NURSCATY,NSPEC,NNM)=X
+6 SET ^TMP($JOB,"L1",X,DA,NURNODE4,NURNODE5)=""
+7 QUIT
End DoDot:1
+8 IF NURNEN=2
if $GET(NURSORT)=""
SET NURSORT=1
Begin DoDot:1
+9 NEW X
SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC))
+10 IF X=""
SET X=NURSORT
SET NURSORT=NURSORT+1
SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NPRI,NSPOSN,NSPEC)=X
+11 SET ^TMP($JOB,"L1",X,NNM,DA,NURNODE4)=""
+12 QUIT
End DoDot:1
+13 IF NURNEN=3
if $GET(NURSORT)=""
SET NURSORT=1
Begin DoDot:1
+14 NEW X
SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC))
+15 IF X=""
SET X=NURSORT
SET NURSORT=NURSORT+1
SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NURSCATY,NSPEC)=X
+16 SET ^TMP($JOB,"L1",X,NNM,DA,NURNODE4,NURNODE5)=""
+17 QUIT
End DoDot:1
+18 IF NURNEN=4
if $GET(NURSORT)=""
SET NURSORT=1
Begin DoDot:1
+19 NEW X
SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN))
+20 IF X=""
SET X=NURSORT
SET NURSORT=NURSORT+1
SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN)=X
+21 SET ^TMP($JOB,"L1",X,NSPEC,NNM,DA,NURNODE4)=""
+22 QUIT
End DoDot:1
+23 QUIT
CHKPOS ; SELECT ACTIVE POSITIONS
+1 SET NURNEN(1)=0
IF $PIECE(^NURSF(211.8,NURNODE4,1,NURNODE5,0),U)'>DT&('$PIECE(^(0),U,6)!($PIECE(^(0),U,6)'<DT))
SET NURNEN(1)=1
+2 QUIT
