NURADEG3.m

NURADEG3 ;HIRMFO/JH-INDEVIDUAL, COMBINED EDUCATIONAL REPORT ;6/14/94

 ;;4.0;NURSING SERVICE;;Apr 25, 1997

 S (NURPAGE,NUROUT,NURQUIT)=0,DA=N1 D EN3^NURSUT0 S NLO=$S($P($G(^NURSF(211.8,+NOD1,0)),U)'="":$P(^(0),U),1:"  BLANK")

 S NPWARD=NLO D EN7^NURSAUTL S DA=N1,DA(1)=N2

 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,$P(^VA(200,DA(1),0),U),$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_U_NPWARD_U_NPSPOS

 .  Q

QUIT K I,DATA,NURNODE4,ZZ,%DT,NX,NOD1,NOD2,NURFLAG,NPSPOS,N2,NO,N1,D1,NURHOSP,DIC,M,NADT,NL1,NLO,NI,NO,NURSZDA,NURSZORT,NURSZLO,NURSZAP,NURSZSP,NPWARD,N,NAD,NJ,NUREQWRD

 Q

NURADEG3  ;HIRMFO/JH-INDEVIDUAL, COMBINED EDUCATIONAL REPORT ;6/14/94

 +1       ;;4.0;NURSING SERVICE;;Apr 25, 1997

 +2        SET (NURPAGE,NUROUT,NURQUIT)=0

           SET DA=N1

           DO EN3^NURSUT0

           SET NLO=$SELECT($PIECE($GET(^NURSF(211.8,+NOD1,0)),U)'="":$PIECE(^(0),U),1:"  BLANK")

 +3        SET NPWARD=NLO

           DO EN7^NURSAUTL

           SET DA=N1

           SET DA(1)=N2

 +4        SET II=0

           FOR I=0:0

               SET II=$ORDER(^NURSF(210,DA,6,II))

               IF II'>0

                   QUIT 

               Begin DoDot:1

 +5                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,$PIECE(^VA(200,DA(1),0),U),$SELECT(NURASSN'="":NURASSN,1:999999999),II)=NURAH

 +6                QUIT 

               End DoDot:1

 +7        SET NURAHIGH=$GET(^NURSF(210,DA,17))

           IF '$PIECE(NURAHIGH,U)&('$PIECE(NURAHIGH,U,2))

               QUIT 

           SET (NURANUR,NURAACA)=""

           Begin DoDot:1

 +8            IF $PIECE(NURAHIGH,U)'=""

                   SET NURANUR=$PIECE($GET(^NURSF(212.1,$PIECE(NURAHIGH,U),0)),U)

 +9            IF $PIECE(NURAHIGH,U,2)'=""

                   SET NURAACA=$PIECE($GET(^NURSF(212.1,$PIECE(NURAHIGH,U,2),0)),U)

 +10           IF $DATA(NURANUR)!($DATA(NURAACA))

                   SET ^TMP($JOB,"HIGH",DA)=NURANUR_U_NURAACA_U_NPWARD_U_NPSPOS

 +11           QUIT 

           End DoDot:1

QUIT       KILL I,DATA,NURNODE4,ZZ,%DT,NX,NOD1,NOD2,NURFLAG,NPSPOS,N2,NO,N1,D1,NURHOSP,DIC,M,NADT,NL1,NLO,NI,NO,NURSZDA,NURSZORT,NURSZLO,NURSZAP,NURSZSP,NPWARD,N,NAD,NJ,NUREQWRD

 +1        QUIT