- NURADEG2 ;HIRMFO/JH,FT-COMBINED EDUCATIONAL REPORT BY SERVICE ;6/14/94
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- S (NURQUIT,NURPAGE,NUROUT)=0 W !
- S X="" F S X=$O(^NURSF(210,"AC",X)) Q:X="" I X'="R" F DA=0:0 S DA=$O(^NURSF(210,"AC",X,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
- K %DT,NDA,NOD1,NOD2,NURNODE4,NURNODE5,Y,NURSCAT,NURCAT,NURCAT,NRNLPN,X,J,K,N,NL,NOD,ATD,NJ,D1
- QUIT K NURS132,DATA,ZZ,I,NSPC,D0,DIC,NURFLAG,NPSPOS,M,NADT,NLDTPR,NLO,NSP,NTD,N1,NURCAT,NL1,NK,NURSZDA,NURSZLO,NURSZAP,NURSZORT,NURSZSP,NPWARD,NUREQWRD
- Q
- SORT1 F NURNODE4=0:0 S NURNODE4=$O(^NURSF(211.8,"C",DA(1),NURNODE4)) Q:NURNODE4'>0 F NURNODE5=0:0 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=1 D SETFAC^NURAAGS1,SETPROG^NURAAGS1
- I $D(^VA(200,DA(1),0)),$P(^(0),"^",1)'="" S N1=$P(^(0),"^",1)
- E S N1=" BLANK"
- S NLO=$S($D(^NURSF(211.8,NURNODE4,0))&($P(^(0),"^")'=""):$P(^(0),"^"),1:" BLANK")
- E S NLO=" 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
- 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 NPWARD=NLO D EN7^NURSAUTL S NL1=$S(NPWARD'="":NPWARD,1:" BLANK")
- 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_U_NPWARD_U_NPSPOS
- . Q
- S ^TMP($J,"SER",NURFAC(2),NURPROG(2),NPSPOS(1),DA)=""
- Q
- NURADEG2 ;HIRMFO/JH,FT-COMBINED EDUCATIONAL REPORT BY SERVICE ;6/14/94
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- +2 SET (NURQUIT,NURPAGE,NUROUT)=0
- WRITE !
- +3 SET X=""
- FOR
- SET X=$ORDER(^NURSF(210,"AC",X))
- IF X=""
- QUIT
- IF X'="R"
- FOR DA=0:0
- SET DA=$ORDER(^NURSF(210,"AC",X,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
- +4 KILL %DT,NDA,NOD1,NOD2,NURNODE4,NURNODE5,Y,NURSCAT,NURCAT,NURCAT,NRNLPN,X,J,K,N,NL,NOD,ATD,NJ,D1
- QUIT KILL NURS132,DATA,ZZ,I,NSPC,D0,DIC,NURFLAG,NPSPOS,M,NADT,NLDTPR,NLO,NSP,NTD,N1,NURCAT,NL1,NK,NURSZDA,NURSZLO,NURSZAP,NURSZORT,NURSZSP,NPWARD,NUREQWRD
- +1 QUIT
- SORT1 FOR NURNODE4=0:0
- SET NURNODE4=$ORDER(^NURSF(211.8,"C",DA(1),NURNODE4))
- IF NURNODE4'>0
- QUIT
- FOR NURNODE5=0:0
- 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 IF NURSZAP>7&(NURSZDA'=DA)
- QUIT
- SET NURSZORT=1
- IF NURSZAP>6
- DO EN3^NURSAUTL
- IF NURSZORT&NURSZAP
- DO EN2^NURSAUTL
- IF 'NURSZORT
- QUIT
- +1 SET NURNEN=1
- DO SETFAC^NURAAGS1
- DO SETPROG^NURAAGS1
- +2 IF $DATA(^VA(200,DA(1),0))
- IF $PIECE(^(0),"^",1)'=""
- SET N1=$PIECE(^(0),"^",1)
- +3 IF '$TEST
- SET N1=" BLANK"
- +4 SET NLO=$SELECT($DATA(^NURSF(211.8,NURNODE4,0))&($PIECE(^(0),"^")'=""):$PIECE(^(0),"^"),1:" BLANK")
- +5 IF '$TEST
- SET NLO=" 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 IF NURMDSW
- IF '$GET(NURFAC)
- IF $GET(NURFAC(1))'=$GET(NURFAC(2))
- QUIT
- +11 IF NURPLSW
- IF '$GET(NURPROG)
- IF $GET(NURPROG(1))'=$GET(NURPROG(2))
- QUIT
- +12 IF NURPROG(2)="NURSING"
- SET NURPROG(2)=" "_NURPROG(2)
- +13 SET NPWARD=NLO
- DO EN7^NURSAUTL
- SET NL1=$SELECT(NPWARD'="":NPWARD,1:" BLANK")
- +14 SET II=0
- FOR I=0:0
- SET II=$ORDER(^NURSF(210,DA,6,II))
- IF II'>0
- QUIT
- Begin DoDot:1
- +15 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
- +16 QUIT
- End DoDot:1
- +17 SET NURAHIGH=$GET(^NURSF(210,DA,17))
- IF '$PIECE(NURAHIGH,U)&('$PIECE(NURAHIGH,U,2))
- QUIT
- SET (NURANUR,NURAACA)=""
- Begin DoDot:1
- +18 IF $PIECE(NURAHIGH,U)'=""
- SET NURANUR=$PIECE($GET(^NURSF(212.1,$PIECE(NURAHIGH,U),0)),U)
- +19 IF $PIECE(NURAHIGH,U,2)'=""
- SET NURAACA=$PIECE($GET(^NURSF(212.1,$PIECE(NURAHIGH,U,2),0)),U)
- +20 IF $DATA(NURANUR)!($DATA(NURAACA))
- SET ^TMP($JOB,"HIGH",DA)=NURANUR_U_NURAACA_U_NPWARD_U_NPSPOS
- +21 QUIT
- End DoDot:1
- +22 SET ^TMP($JOB,"SER",NURFAC(2),NURPROG(2),NPSPOS(1),DA)=""
- +23 QUIT
