NURAAGS0 ;HIRMFO/RM,JH,MD-MULTIDIVISIONAL GENERIC SORT ROUTINE FOR ADMIN REPORTS ;11/18/96
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; SER.CAT-SPEC. SORT
S NURNEN=1 D ACSORT
G Q
EN2 ; PRIO.SQ.-SER.POS.-SPEC. SORT
I 'NURSER S NURNEN=2 D CSORT G Q
S NURNEN=2 D ACSORT
G Q
EN3 ; LOC-SER.CAT.-SPEC. SORT
S NURNEN=3
I 'NURHOSP D ESORT G Q
D ACSORT,EN4^NURSAUTL:NURSZAP=7
G Q
EN4 ; LOC.-PRIO.SQ.-SER.POS.-SPEC. SORT
S NURNEN=4
I 'NURHOSP D ESORT G Q
D ACSORT,EN4^NURSAUTL:NURSZAP=7
Q K D0,DA,NURNEN,NLOCN,NNM,NPRI,NURSCATY,NSPEC,NPODA,NSPOSN,NURSZORT,NPWARD,NURNODE4,NUREQWRD,NURCAT,NURFLAG,NURSCAT,NURSZ
Q
ACSORT ; SORT FROM NURSING "AC" & "C" XREF
S Z="" F S Z=$O(^NURSF(210,"AC",Z)) Q:Z="" I Z'="R" S DA=0 F S DA=$O(^NURSF(210,"AC",Z,DA)) Q:DA'>0 I +$G(^NURSF(210,DA,0)) S DA(1)=+^(0) D:$D(^VA(200,DA(1),0))
.S NURNODE4=0 F S NURNODE4=$O(^NURSF(211.8,"C",DA(1),NURNODE4)) Q:NURNODE4'>0 S NURNODE5=0 F S NURNODE5=$O(^NURSF(211.8,"C",DA(1),NURNODE4,NURNODE5)) Q:NURNODE5'>0 D CHKPOS^NURAAGS1 D:+NURNEN(1) SETVAR
.Q
Q
ESORT ; SORT FROM NURSING "B" XREF
S NURSZ="" F S NURSZ=$O(NURSNLOC(NURSZ)) Q:NURSZ="" S NURSIEN=0 F S NURSIEN=$O(NURSNLOC(NURSZ,NURSIEN)) Q:NURSIEN'>0 S NUREQWRD=+$G(NURSNLOC(NURSZ,NURSIEN)) D:+NUREQWRD
.S NURNODE4=0 F S NURNODE4=$O(^NURSF(211.8,"B",NUREQWRD,NURNODE4)) Q:NURNODE4'>0 S NURNODE5=0 F S NURNODE5=$O(^NURSF(211.8,NURNODE4,1,NURNODE5)) Q:NURNODE5'>0 D CHKPOS^NURAAGS1 D:+NURNEN(1)
..S DA(1)=$S($D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)):$P(^(0),U,2),1:""),DA=$O(^NURSF(210,"B",DA(1),0)) I (+DA>0),'$D(^NURSF(210,"AC","R",+DA)),$D(^VA(200,DA(1),0)) D SETVAR
..Q
.Q
Q
CSORT ; SORT FROM NURSING "D" XREF
S DA(1)=0 F S DA(1)=$O(^NURSF(211.8,"AD",DA(1))) Q:DA(1)'>0 S NURNODE4=0 F S NURNODE4=$O(^NURSF(211.8,"AD",DA(1),NPOS,NURNODE4)) Q:NURNODE4'>0 D
.S NURNODE5=0 F S NURNODE5=$O(^NURSF(211.8,"AD",DA(1),NPOS,NURNODE4,NURNODE5)) Q:NURNODE5'>0 S DA=$O(^NURSF(210,"B",DA(1),0)) I $P($G(^NURSF(210,+DA,0)),U,2)'="R",'$D(^NURSF(210,"AC","R",+DA)) D CHKPOS^NURAAGS1 D:NURNEN(1) SETVAR
.Q
Q
SETVAR ; SET SUBSCRIPTS FOR GLOBAL SET
S NURSZORT=1 I NRPT=10 S:NURSZAP&(NURSZDA'=DA)&(NURSZAP>7) NURSZORT=0
E D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP
Q:'NURSZORT
D SETCAT^NURAAGS1:NURNEN=1!(NURNEN=3),SETPOS^NURAAGS1:NURNEN=2!(NURNEN=4),SETFAC^NURAAGS1,SETPROG^NURAAGS1,SETLOC^NURAAGS1
I $D(^NURSF(211.4,"B",+NLOCN)) S NLOCN(2)=$O(^NURSF(211.4,"B",+NLOCN,0)) I $D(^NURSF(211.4,NLOCN(2),"I")),$E($P(^("I"),U))="I" Q
I $G(NURMDSW),'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
I $G(NURPLSW),$G(NURPROG)=0,$G(NURPROG(1))'=$G(NURPROG(2)) Q
I $G(NURPLSW) S:NURPROG(2)="NURSING" NURPROG(2)=" NURSING"
I (NURNEN=3!(NURNEN=4)),'NURHOSP,'$D(NURSNLOC(NLOCN(1))) Q
I (NURNEN=1!(NURNEN=3)),$S($E(NURSCATY)'="O":'$D(^TMP("NURSCAT",$J,$E(NURSCATY))),$P($G(NURSCATY),"O ",2)="":'$D(^TMP("NURSCAT",$J,$E(NURSCATY))),$P($G(NURSCATY),"O ",2)'="":'$D(^TMP("NURSCAT",$J,$E(NURSCATY,3,99))),1:0) Q
I (NURNEN=2!(NURNEN=4)) S NPODA=$O(^NURSF(211.3,"B",NSPOSN,"")) Q:NPODA="" Q:'$D(^NURSF(211.3,NPODA,0)) I $S((NRPT=6!(NRPT=2))&NURSER&($P(^NURSF(211.3,NPODA,0),U,5)'="R"):1,NURSER:0,NPOS'=NPODA:1,1:0) Q
Q:'$D(^VA(200,DA(1),0)) S NNM=$S($P(^VA(200,DA(1),0),U)'="":$P(^(0),U),1:"VA # "_DA(1))
K NSPEC I NRPT=1 I $P($G(^NURSF(210,DA,17)),U,2)'="",$D(^NURSF(212.1,$P(^NURSF(210,DA,17),U,2),0)),$P(^(0),U,3)'="" S NSPEC=$P(^(0),U,3)
I NRPT=2 S D0=0 F S D0=$O(^NURSF(210,DA,12,D0)) Q:D0'>0 D SETCERT^NURAAGS1
I NRPT=3 Q:$S('$D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)):1,NURSZAP<7:0,$D(NURSZLO($O(^NURSF(211.4,"B",+$P(^NURSF(211.8,NURNODE4,0),U),"")))):0,1:1) I $P($G(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),U,4)'="" S NSPEC=$P(^(0),U,4)
I NRPT=4 I $P($G(^VA(200,DA(1),1)),U,2)'="" S NSPEC=$P(^(1),U,2)
I NRPT=5 I $P($G(^NURSF(210,DA,7)),U,1)'="",$P($G(^NURSF(211.1,$P(^NURSF(210,DA,7),U,1),0)),U,1)'="" S NSPEC=$P(^(0),U,1)
I NRPT=6 I $P($G(^NURSF(210,DA,17)),U,1),$P($G(^NURSF(212.1,$P(^NURSF(210,DA,17),U,1),0)),U,1)'="" S NSPEC=$P(^(0),U,3)
I NRPT=7 I $D(^VA(200,DA(1),1)) S NSPEC=$S(+$P(^(1),U,3):$P(^(1),U,3),1:"BLANK") I 'NSP,(+NSPEC<NSPC!(+NSPEC>NSPC(1))) Q
I NRPT=8 S D0=0 F S D0=$O(^NURSF(210,DA,4,D0)) Q:D0'>0 D
.I '$G(NSTAT),$G(NSTAT(1))'=+$G(^NURSF(210,DA,4,D0,0)) Q
.D:NURSCATY="R"!(NURSCATY="L")!($E(NURSCATY)="O") SETLIC^NURAAGS1,SETUPTL^NURAAGS1:$S(NSP:1,$E(NSPEC,1,7)'<NSPC&($E(NSPEC,1,7)'>NSPC(2)):1,1:0)
.Q
I NRPT=8,'$O(^NURSF(210,DA,4,0)),NURSCATY="R"!(NURSCATY="L")!($E(NURSCATY)="O") S NSPEC=" BLANK"_0 D SETUPTL^NURAAGS1:$S(NSP:1,$E(NSPEC,1,7)'<NSPC&($E(NSPEC,1,7)'>NSPC(2)):1,1:0)
I NRPT=9 S D0=0 F S D0=$O(^NURSF(210,DA,10,D0)) Q:D0'>0 D SETMIL^NURAAGS1
I NRPT=10 S:$G(NURSORT)="" NURSORT=1 D Q
.I NURPLSW,NURPROG(2)'=" BLANK" S NURPROG(3)=+$O(^NURSF(212.7,"NURSING",0)),NURPROG(3)=$$GET1^DIQ(212.7,NURPROG(3),.01,"I")
.N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN))
.W:$E(IOST)="C"&($R(100)) "." 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,NNM,DA,NURNODE4)=""
.Q
Q:(NRPT=2)!(NRPT=8)!(NRPT=9)
I NRPT=6,$D(NURSCATY),NURSCATY'="R" Q
I NRPT=6,$D(NSPOSN),1=$S($O(^NURSF(211.3,"B",NSPOSN,""))="":0,$P(^NURSF(211.3,$O(^NURSF(211.3,"B",NSPOSN,"")),0),U,5)'="R":1,1:0) Q
I '$D(NSPEC) S NSPEC=" BLANK"
Q:NRPT=1!(NRPT=7)&(NSPEC=" BLANK")
I NRPT'=7,'NSP,NSPC'=NSPEC Q
D SETUPTL^NURAAGS1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAAGS0 5448 printed Nov 22, 2024@17:28:49 Page 2
NURAAGS0 ;HIRMFO/RM,JH,MD-MULTIDIVISIONAL GENERIC SORT ROUTINE FOR ADMIN REPORTS ;11/18/96
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; SER.CAT-SPEC. SORT
+1 SET NURNEN=1
DO ACSORT
+2 GOTO Q
EN2 ; PRIO.SQ.-SER.POS.-SPEC. SORT
+1 IF 'NURSER
SET NURNEN=2
DO CSORT
GOTO Q
+2 SET NURNEN=2
DO ACSORT
+3 GOTO Q
EN3 ; LOC-SER.CAT.-SPEC. SORT
+1 SET NURNEN=3
+2 IF 'NURHOSP
DO ESORT
GOTO Q
+3 DO ACSORT
if NURSZAP=7
DO EN4^NURSAUTL
+4 GOTO Q
EN4 ; LOC.-PRIO.SQ.-SER.POS.-SPEC. SORT
+1 SET NURNEN=4
+2 IF 'NURHOSP
DO ESORT
GOTO Q
+3 DO ACSORT
if NURSZAP=7
DO EN4^NURSAUTL
Q KILL D0,DA,NURNEN,NLOCN,NNM,NPRI,NURSCATY,NSPEC,NPODA,NSPOSN,NURSZORT,NPWARD,NURNODE4,NUREQWRD,NURCAT,NURFLAG,NURSCAT,NURSZ
+1 QUIT
ACSORT ; SORT FROM NURSING "AC" & "C" XREF
+1 SET Z=""
FOR
SET Z=$ORDER(^NURSF(210,"AC",Z))
if Z=""
QUIT
IF Z'="R"
SET DA=0
FOR
SET DA=$ORDER(^NURSF(210,"AC",Z,DA))
if DA'>0
QUIT
IF +$GET(^NURSF(210,DA,0))
SET DA(1)=+^(0)
if $DATA(^VA(200,DA(1),0))
Begin DoDot:1
+2 SET NURNODE4=0
FOR
SET NURNODE4=$ORDER(^NURSF(211.8,"C",DA(1),NURNODE4))
if NURNODE4'>0
QUIT
SET NURNODE5=0
FOR
SET NURNODE5=$ORDER(^NURSF(211.8,"C",DA(1),NURNODE4,NURNODE5))
if NURNODE5'>0
QUIT
DO CHKPOS^NURAAGS1
if +NURNEN(1)
DO SETVAR
+3 QUIT
End DoDot:1
+4 QUIT
ESORT ; SORT FROM NURSING "B" XREF
+1 SET NURSZ=""
FOR
SET NURSZ=$ORDER(NURSNLOC(NURSZ))
if NURSZ=""
QUIT
SET NURSIEN=0
FOR
SET NURSIEN=$ORDER(NURSNLOC(NURSZ,NURSIEN))
if NURSIEN'>0
QUIT
SET NUREQWRD=+$GET(NURSNLOC(NURSZ,NURSIEN))
if +NUREQWRD
Begin DoDot:1
+2 SET NURNODE4=0
FOR
SET NURNODE4=$ORDER(^NURSF(211.8,"B",NUREQWRD,NURNODE4))
if NURNODE4'>0
QUIT
SET NURNODE5=0
FOR
SET NURNODE5=$ORDER(^NURSF(211.8,NURNODE4,1,NURNODE5))
if NURNODE5'>0
QUIT
DO CHKPOS^NURAAGS1
if +NURNEN(1)
Begin DoDot:2
+3 SET DA(1)=$SELECT($DATA(^NURSF(211.8,NURNODE4,1,NURNODE5,0)):$PIECE(^(0),U,2),1:"")
SET DA=$ORDER(^NURSF(210,"B",DA(1),0))
IF (+DA>0)
IF '$DATA(^NURSF(210,"AC","R",+DA))
IF $DATA(^VA(200,DA(1),0))
DO SETVAR
+4 QUIT
End DoDot:2
+5 QUIT
End DoDot:1
+6 QUIT
CSORT ; SORT FROM NURSING "D" XREF
+1 SET DA(1)=0
FOR
SET DA(1)=$ORDER(^NURSF(211.8,"AD",DA(1)))
if DA(1)'>0
QUIT
SET NURNODE4=0
FOR
SET NURNODE4=$ORDER(^NURSF(211.8,"AD",DA(1),NPOS,NURNODE4))
if NURNODE4'>0
QUIT
Begin DoDot:1
+2 SET NURNODE5=0
FOR
SET NURNODE5=$ORDER(^NURSF(211.8,"AD",DA(1),NPOS,NURNODE4,NURNODE5))
if NURNODE5'>0
QUIT
SET DA=$ORDER(^NURSF(210,"B",DA(1),0))
IF $PIECE($GET(^NURSF(210,+DA,0)),U,2)'="R"
IF '$DATA(^NURSF(210,"AC","R",+DA))
DO CHKPOS^NURAAGS1
if NURNEN(1)
DO SETVAR
+3 QUIT
End DoDot:1
+4 QUIT
SETVAR ; SET SUBSCRIPTS FOR GLOBAL SET
+1 SET NURSZORT=1
IF NRPT=10
if NURSZAP&(NURSZDA'=DA)&(NURSZAP>7)
SET NURSZORT=0
+2 IF '$TEST
if NURSZAP>6
DO EN3^NURSAUTL
if NURSZORT&NURSZAP
DO EN2^NURSAUTL
+3 if 'NURSZORT
QUIT
+4 if NURNEN=1!(NURNEN=3)
DO SETCAT^NURAAGS1
if NURNEN=2!(NURNEN=4)
DO SETPOS^NURAAGS1
DO SETFAC^NURAAGS1
DO SETPROG^NURAAGS1
DO SETLOC^NURAAGS1
+5 IF $DATA(^NURSF(211.4,"B",+NLOCN))
SET NLOCN(2)=$ORDER(^NURSF(211.4,"B",+NLOCN,0))
IF $DATA(^NURSF(211.4,NLOCN(2),"I"))
IF $EXTRACT($PIECE(^("I"),U))="I"
QUIT
+6 IF $GET(NURMDSW)
IF '$GET(NURFAC)
IF $GET(NURFAC(1))'=$GET(NURFAC(2))
QUIT
+7 IF $GET(NURPLSW)
IF $GET(NURPROG)=0
IF $GET(NURPROG(1))'=$GET(NURPROG(2))
QUIT
+8 IF $GET(NURPLSW)
if NURPROG(2)="NURSING"
SET NURPROG(2)=" NURSING"
+9 IF (NURNEN=3!(NURNEN=4))
IF 'NURHOSP
IF '$DATA(NURSNLOC(NLOCN(1)))
QUIT
+10 IF (NURNEN=1!(NURNEN=3))
IF $SELECT($EXTRACT(NURSCATY)'="O":'$DATA(^TMP("NURSCAT",$JOB,$EXTRACT(NURSCATY))),$PIECE($GET(NURSCATY),"O ",2)="":'$DATA(^TMP("NURSCAT",$JOB,$EXTRACT(NURSCATY))),$PIECE($GET(NURSCATY),"O ",2)'="":'$DATA(^TMP("NURSCAT",$JOB,...
... $EXTRACT(NURSCATY,3,99))),1:0)
QUIT
+11 IF (NURNEN=2!(NURNEN=4))
SET NPODA=$ORDER(^NURSF(211.3,"B",NSPOSN,""))
if NPODA=""
QUIT
if '$DATA(^NURSF(211.3,NPODA,0))
QUIT
IF $SELECT((NRPT=6!(NRPT=2))&NURSER&($PIECE(^NURSF(211.3,NPODA,0),U,5)'="R"):1,NURSER:0,NPOS'=NPODA:1,1:0)
QUIT
+12 if '$DATA(^VA(200,DA(1),0))
QUIT
SET NNM=$SELECT($PIECE(^VA(200,DA(1),0),U)'="":$PIECE(^(0),U),1:"VA # "_DA(1))
+13 KILL NSPEC
IF NRPT=1
IF $PIECE($GET(^NURSF(210,DA,17)),U,2)'=""
IF $DATA(^NURSF(212.1,$PIECE(^NURSF(210,DA,17),U,2),0))
IF $PIECE(^(0),U,3)'=""
SET NSPEC=$PIECE(^(0),U,3)
+14 IF NRPT=2
SET D0=0
FOR
SET D0=$ORDER(^NURSF(210,DA,12,D0))
if D0'>0
QUIT
DO SETCERT^NURAAGS1
+15 IF NRPT=3
if $SELECT('$DATA(^NURSF(211.8,NURNODE4,1,NURNODE5,0))
QUIT
IF $PIECE($GET(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),U,4)'=""
SET NSPEC=$PIECE(^(0),U,4)
+16 IF NRPT=4
IF $PIECE($GET(^VA(200,DA(1),1)),U,2)'=""
SET NSPEC=$PIECE(^(1),U,2)
+17 IF NRPT=5
IF $PIECE($GET(^NURSF(210,DA,7)),U,1)'=""
IF $PIECE($GET(^NURSF(211.1,$PIECE(^NURSF(210,DA,7),U,1),0)),U,1)'=""
SET NSPEC=$PIECE(^(0),U,1)
+18 IF NRPT=6
IF $PIECE($GET(^NURSF(210,DA,17)),U,1)
IF $PIECE($GET(^NURSF(212.1,$PIECE(^NURSF(210,DA,17),U,1),0)),U,1)'=""
SET NSPEC=$PIECE(^(0),U,3)
+19 IF NRPT=7
IF $DATA(^VA(200,DA(1),1))
SET NSPEC=$SELECT(+$PIECE(^(1),U,3):$PIECE(^(1),U,3),1:"BLANK")
IF 'NSP
IF (+NSPEC<NSPC!(+NSPEC>NSPC(1)))
QUIT
+20 IF NRPT=8
SET D0=0
FOR
SET D0=$ORDER(^NURSF(210,DA,4,D0))
if D0'>0
QUIT
Begin DoDot:1
+21 IF '$GET(NSTAT)
IF $GET(NSTAT(1))'=+$GET(^NURSF(210,DA,4,D0,0))
QUIT
+22 if NURSCATY="R"!(NURSCATY="L")!($EXTRACT(NURSCATY)="O")
DO SETLIC^NURAAGS1
if $SELECT(NSP:1,$EXTRACT(NSPEC,1,7)'<NSPC&($EXTRACT(NSPEC,1,7)'>NSPC(2)):1,1:0)
DO SETUPTL^NURAAGS1
+23 QUIT
End DoDot:1
+24 IF NRPT=8
IF '$ORDER(^NURSF(210,DA,4,0))
IF NURSCATY="R"!(NURSCATY="L")!($EXTRACT(NURSCATY)="O")
SET NSPEC=" BLANK"_0
if $SELECT(NSP:1,$EXTRACT(NSPEC,1,7)'<NSPC&($EXTRACT(NSPEC,1,7)'>NSPC(2)):1,1:0)
DO SETUPTL^NURAAGS1
+25 IF NRPT=9
SET D0=0
FOR
SET D0=$ORDER(^NURSF(210,DA,10,D0))
if D0'>0
QUIT
DO SETMIL^NURAAGS1
+26 IF NRPT=10
if $GET(NURSORT)=""
SET NURSORT=1
Begin DoDot:1
+27 IF NURPLSW
IF NURPROG(2)'=" BLANK"
SET NURPROG(3)=+$ORDER(^NURSF(212.7,"NURSING",0))
SET NURPROG(3)=$$GET1^DIQ(212.7,NURPROG(3),.01,"I")
+28 NEW X
SET X=$GET(^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN))
+29 if $EXTRACT(IOST)="C"&($RANDOM(100))
WRITE "."
IF X=""
SET X=NURSORT
SET NURSORT=NURSORT+1
SET ^TMP($JOB,"L",NURFAC(2),NURPROG(2),NLOCN(1),NPRI,NSPOSN)=X
+30 SET ^TMP($JOB,"L1",X,NNM,DA,NURNODE4)=""
+31 QUIT
End DoDot:1
QUIT
+32 if (NRPT=2)!(NRPT=8)!(NRPT=9)
QUIT
+33 IF NRPT=6
IF $DATA(NURSCATY)
IF NURSCATY'="R"
QUIT
+34 IF NRPT=6
IF $DATA(NSPOSN)
IF 1=$SELECT($ORDER(^NURSF(211.3,"B",NSPOSN,""))="":0,$PIECE(^NURSF(211.3,$ORDER(^NURSF(211.3,"B",NSPOSN,"")),0),U,5)'="R":1,1:0)
QUIT
+35 IF '$DATA(NSPEC)
SET NSPEC=" BLANK"
+36 if NRPT=1!(NRPT=7)&(NSPEC=" BLANK")
QUIT
+37 IF NRPT'=7
IF 'NSP
IF NSPC'=NSPEC
QUIT
+38 DO SETUPTL^NURAAGS1
QUIT
