NURADEG1 ;HIRMFO/JH,FT-COMBINED EDUCATIONAL REPORT BY LOCATION ;8/9/96 09:17
;;4.0;NURSING SERVICE;;Apr 25, 1997
S (NURQUIT,NURPAGE,NUROUT)=0,NURNODE4="" W !
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 $D(^NURSF(210,DA,0)),+$P(^(0),U) S DA(1)=$P(^(0),U) W:$R(100)&($E(IOST)="C") "." D SORT1
QUIT K D1,NOD1,NOD2,NURNODE4,NSPC,D0,DIC,M,NWRD,NURHOSP,NLO,NURNODE5,NURS132,DATA,I,NSP,NADT,N1,NL1,NURSZORT,NURSZDA,NURSZLO,NURSZAP,NURSZSP,NPWARD,NAD,NJ,NURSI,NPSPOS,NURCAT,Z,ZZ,NRNLPN,NURCAT
Q
SORT1 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
.I $D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),$P(^(0),U)'>DT&(('$P(^(0),U,6))!($P(^(0),U,6)'<DT)) D SORT2
.Q
Q
SORT2 ;
Q:NURSZAP>7&(NURSZDA'=DA) S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP Q:'NURSZORT
S NURNEN=3 D SETFAC^NURAAGS1,SETPROG^NURAAGS1
I $D(^VA(200,DA(1),0)),$P(^(0),U)'="" S N1=$P(^(0),U)
E S N1=" BLANK"
S NLO=$S($D(^NURSF(211.8,NURNODE4,0))&($P(^(0),U)'=""):$P(^(0),U),1:" BLANK")
I $D(^NURSF(211.4,"B",+NLO)) S NLO(1)=$O(^NURSF(211.4,"B",+NLO,0)) I $D(^NURSF(211.4,+NLO(1),"I")),$E($P(^("I"),"^"))="I" Q
D EN2^NURSUT0 Q:NPSPOS="" S Y=$G(^NURSF(211.3,+NPSPOS(0),0))
I Y'="" S NURSCATY=$P(Y,U,5) S:NURSCATY="O" NURSCATY=NURSCATY_" "_$P(Y,U,6)
I $S($E(NURSCATY)'="O":'$D(^TMP("NURSCAT",$J,NURSCATY)),$P($G(NURSCATY),"O ",2)'="":'$D(^TMP("NURSCAT",$J,$E(NURSCATY,3,99))),1:0) Q
S NPWARD=NLO D EN7^NURSAUTL S NL1=$S(NPWARD'="":NPWARD,1:" BLANK")
I 'NURHOSP,'$D(NURSNLOC(NL1)) Q
I NURMDSW,'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
I NURPLSW,'$G(NURPROG),$G(NURPROG(1))'=$G(NURPROG(2)) Q
S:NURPROG(2)="NURSING" NURPROG(2)=" "_NURPROG(2)
S II=0 F I=0:0 S II=$O(^NURSF(210,DA,6,II)) Q:II'>0 D
. S NURAH=^NURSF(212.1,$P(^NURSF(210,DA,6,II,0),U),0),NURASSN=$P($G(^VA(200,DA(1),1)),U,9),^TMP($J,"DEG",DA,N1,$S(NURASSN'="":NURASSN,1:999999999),II)=NURAH
. Q
S NURAHIGH=$G(^NURSF(210,DA,17)) Q:'$P(NURAHIGH,U)&('$P(NURAHIGH,U,2)) S (NURANUR,NURAACA)="" D
. I $P(NURAHIGH,U)'="" S NURANUR=$P($G(^NURSF(212.1,$P(NURAHIGH,U),0)),U)
. I $P(NURAHIGH,U,2)'="" S NURAACA=$P($G(^NURSF(212.1,$P(NURAHIGH,U,2),0)),U)
. S:$D(NURANUR)!($D(NURAACA)) ^TMP($J,"HIGH",DA)=NURANUR_U_NURAACA
. Q
S ^TMP($J,"LOC",NURFAC(2),NURPROG(2),NL1,NPSPOS(1),DA)="",^TMP($J,"HIGH",DA)=^TMP($J,"HIGH",DA)_U_NPWARD_U_NPSPOS(1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURADEG1 2525 printed Oct 16, 2024@18:19:53 Page 2
NURADEG1 ;HIRMFO/JH,FT-COMBINED EDUCATIONAL REPORT BY LOCATION ;8/9/96 09:17
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
+2 SET (NURQUIT,NURPAGE,NUROUT)=0
SET NURNODE4=""
WRITE !
+3 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 $DATA(^NURSF(210,DA,0))
IF +$PIECE(^(0),U)
SET DA(1)=$PIECE(^(0),U)
if $RANDOM(100)&($EXTRACT(IOST)="C")
WRITE "."
DO SORT1
QUIT KILL D1,NOD1,NOD2,NURNODE4,NSPC,D0,DIC,M,NWRD,NURHOSP,NLO,NURNODE5,NURS132,DATA,I,NSP,NADT,N1,NL1,NURSZORT,NURSZDA,NURSZLO,NURSZAP,NURSZSP,NPWARD,NAD,NJ,NURSI,NPSPOS,NURCAT,Z,ZZ,NRNLPN,NURCAT
+1 QUIT
SORT1 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
Begin DoDot:1
+1 IF $DATA(^NURSF(211.8,NURNODE4,1,NURNODE5,0))
IF $PIECE(^(0),U)'>DT&(('$PIECE(^(0),U,6))!($PIECE(^(0),U,6)'<DT))
DO SORT2
+2 QUIT
End DoDot:1
+3 QUIT
SORT2 ;
+1 if NURSZAP>7&(NURSZDA'=DA)
QUIT
SET NURSZORT=1
if NURSZAP>6
DO EN3^NURSAUTL
if NURSZORT&NURSZAP
DO EN2^NURSAUTL
if 'NURSZORT
QUIT
+2 SET NURNEN=3
DO SETFAC^NURAAGS1
DO SETPROG^NURAAGS1
+3 IF $DATA(^VA(200,DA(1),0))
IF $PIECE(^(0),U)'=""
SET N1=$PIECE(^(0),U)
+4 IF '$TEST
SET N1=" BLANK"
+5 SET NLO=$SELECT($DATA(^NURSF(211.8,NURNODE4,0))&($PIECE(^(0),U)'=""):$PIECE(^(0),U),1:" BLANK")
+6 IF $DATA(^NURSF(211.4,"B",+NLO))
SET NLO(1)=$ORDER(^NURSF(211.4,"B",+NLO,0))
IF $DATA(^NURSF(211.4,+NLO(1),"I"))
IF $EXTRACT($PIECE(^("I"),"^"))="I"
QUIT
+7 DO EN2^NURSUT0
if NPSPOS=""
QUIT
SET Y=$GET(^NURSF(211.3,+NPSPOS(0),0))
+8 IF Y'=""
SET NURSCATY=$PIECE(Y,U,5)
if NURSCATY="O"
SET NURSCATY=NURSCATY_" "_$PIECE(Y,U,6)
+9 IF $SELECT($EXTRACT(NURSCATY)'="O":'$DATA(^TMP("NURSCAT",$JOB,NURSCATY)),$PIECE($GET(NURSCATY),"O ",2)'="":'$DATA(^TMP("NURSCAT",$JOB,$EXTRACT(NURSCATY,3,99))),1:0)
QUIT
+10 SET NPWARD=NLO
DO EN7^NURSAUTL
SET NL1=$SELECT(NPWARD'="":NPWARD,1:" BLANK")
+11 IF 'NURHOSP
IF '$DATA(NURSNLOC(NL1))
QUIT
+12 IF NURMDSW
IF '$GET(NURFAC)
IF $GET(NURFAC(1))'=$GET(NURFAC(2))
QUIT
+13 IF NURPLSW
IF '$GET(NURPROG)
IF $GET(NURPROG(1))'=$GET(NURPROG(2))
QUIT
+14 if NURPROG(2)="NURSING"
SET NURPROG(2)=" "_NURPROG(2)
+15 SET II=0
FOR I=0:0
SET II=$ORDER(^NURSF(210,DA,6,II))
if II'>0
QUIT
Begin DoDot:1
+16 SET NURAH=^NURSF(212.1,$PIECE(^NURSF(210,DA,6,II,0),U),0)
SET NURASSN=$PIECE($GET(^VA(200,DA(1),1)),U,9)
SET ^TMP($JOB,"DEG",DA,N1,$SELECT(NURASSN'="":NURASSN,1:999999999),II)=NURAH
+17 QUIT
End DoDot:1
+18 SET NURAHIGH=$GET(^NURSF(210,DA,17))
if '$PIECE(NURAHIGH,U)&('$PIECE(NURAHIGH,U,2))
QUIT
SET (NURANUR,NURAACA)=""
Begin DoDot:1
+19 IF $PIECE(NURAHIGH,U)'=""
SET NURANUR=$PIECE($GET(^NURSF(212.1,$PIECE(NURAHIGH,U),0)),U)
+20 IF $PIECE(NURAHIGH,U,2)'=""
SET NURAACA=$PIECE($GET(^NURSF(212.1,$PIECE(NURAHIGH,U,2),0)),U)
+21 if $DATA(NURANUR)!($DATA(NURAACA))
SET ^TMP($JOB,"HIGH",DA)=NURANUR_U_NURAACA
+22 QUIT
End DoDot:1
+23 SET ^TMP($JOB,"LOC",NURFAC(2),NURPROG(2),NL1,NPSPOS(1),DA)=""
SET ^TMP($JOB,"HIGH",DA)=^TMP($JOB,"HIGH",DA)_U_NPWARD_U_NPSPOS(1)
+24 QUIT
