NURSEP31 ;HIRMFO/JH,FT-NURSING MANDATORY INSERVICE CLASS DATA FOR THE LAST THREE YEARS ;3/19/98 13:17
;;4.0;NURSING SERVICE;**2,3,10,9**;Apr 25, 1997
EN1 S X=$G(^PRSE(452.7,1,"OFF")) Q:X=""!(X=1)
S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
S (NUSW,NSP,NURQUIT,NUROUT)=0,YRSW=1 D EN1^NURSAUTL G QUIT:$G(NUROUT)
I NURPLSW=1 D EN13^NURSAGSP G QUIT:$G(NUROUT)
I NURMDSW S DIC(0)="AEQZ",NURPLSCR=1 D EN5^NURSAGSP G:$G(NUROUT) QUIT
I NURMDSW=0,NURPLSW=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
D EN10^NURSUT3($G(DUZ)) W ! S DATSEL="NS^N+" D DATSEL^NURSAGP2 G:$G(NUROUT) QUIT
I NURPLSW=0!($G(NURSEL(1))=1)!($G(NURSEL(1))="") W ! D EN1^NURSAGSP G QUIT:$G(NUROUT)
I NURPLSW=1,$G(NURSEL(1))=2 W ! D EN3^NURSAGSP G QUIT:$G(NUROUT)
D INS^NURSAGP2 G QUIT:$G(NUROUT) D EN5^NURSAGP1 G QUIT:$G(NUROUT)
W ! S ZTDESC="Nursing Mandatory Inservice - last 3 years",ZTRTN="START^NURSEP31" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
START ;
S NURS132=$S(IOM'<132:1,1:0),NURPAGE=0,HH="",$P(HH,"-",$S(NURS132:133,1:81))="",(SLOC,SNM,SIEN,SMC,NOIEN,NOLOC,NOMIC1,NYR)="",FSW=1 S Y=DT X ^DD("DD") S NDATE=Y
K ^TMP("NURE",$J) S X=YRST D COMPARE S YR=Y F Y=0:1:2 S YR(Y)=YR-(Y*10000),YR0(YR-(Y*10000))=""
F NDA=0:0 S NDA=$O(^NURSF(211.8,"C",NDA)) Q:NDA'>0 F NURNODE4=0:0 S NURNODE4=$O(^NURSF(211.8,"C",NDA,NURNODE4)) Q:NURNODE4'>0 D
.F NURNODE5=0:0 S NURNODE5=$O(^NURSF(211.8,"C",NDA,NURNODE4,NURNODE5)) Q:NURNODE5'>0 I $D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),$P(^(0),U)'>DT&(('$P(^(0),U,6))!($P(^(0),U,6)'<DT)) D
..S DA=$O(^NURSF(210,"B",NDA,0)) I $P($G(^NURSF(210,+DA,0)),U,2)'="",$P($G(^(0)),U,2)'="R" W:$R(500)&($E(IOST)="C") "." D SORT
U IO D:NURSZAP=7 EN4^NURSEP3I S NWRD("F")=$O(NURSNLOC(""))
I '$D(^TMP("NURE",$J)) S (MC,NM,IEN,LOC,SP)="",NURFAC=$S($G(NURFAC)=0:$G(NURFAC(1)),1:""),NURPROG=$S($G(NURPROG)=0:$G(NURPROG(1)),1:"") D HDR W !,"THERE IS NO DATA FOR THIS REPORT." G QUIT
S NURFAC=""
F S NURFAC=$O(^TMP("NURE",$J,"L",NURFAC)) Q:NURFAC="" S NURPROG="" F S NURPROG=$O(^TMP("NURE",$J,"L",NURFAC,NURPROG)) Q:NURPROG="" S NURSPEC="" F S NURSPEC=$O(^TMP("NURE",$J,"L",NURFAC,NURPROG,NURSPEC)) Q:NURSPEC=""!$G(NUROUT) D
.D HDR Q:$G(NUROUT)
.S NM="" F S NM=$O(^TMP("NURE",$J,"L",NURFAC,NURPROG,NURSPEC,NM)) Q:NM=""!$G(NUROUT) S NURSORT=$G(^(NM)),NURSPEC(1)=$P(NURSORT,U,2),NURSORT=+NURSORT I NURSORT S IEN="" F S IEN=$O(^TMP("NURE",$J,"L1",NURSORT,IEN)) Q:IEN=""!$G(NUROUT) D FIN
QUIT K ^TMP("NURE",$J) D CLOSE^NURSUT1,^NURSKILL
Q
FIN D:$Y>(IOSL-4) HDR Q:$G(NUROUT) W !,NM_" "_NURSPEC(1),! S MC="" F S MC=$O(^TMP("NURE",$J,"L1",NURSORT,IEN,MC)) Q:MC=""!$G(NUROUT) D FIN1 Q:$G(NUROUT)
Q
FIN1 ;
D PHDR Q:$G(NUROUT) S MC(1)=0 F X=0:1:2 S NYR(YR(X))=0
F I=0:0 D FIN2 Q:$G(NUROUT) W ! Q:NYR(YR(1))="E"&(NYR(YR(0))="E")&(NYR(YR(2))="E")
Q
FIN2 I MC(1)&($Y>(IOSL-4)) D HDR Q:NUROUT W ! D CHDR Q:$G(NUROUT)
F NX=2:-1:0 I NYR(YR(NX))'="E" S NYR(YR(NX))=$O(^TMP("NURE",$J,2,IEN,MC,YR(NX),NYR(YR(NX)))) S:NYR(YR(NX))'>0 NYR(YR(NX))="E" I NYR(YR(NX))'="E" D FIN3
Q
FIN3 S Y=$E(^TMP("NURE",$J,2,IEN,MC,YR(NX),NYR(YR(NX))),1,7),X=$O(^(NYR(YR(NX)))) D D^DIQ S YY=$P(Y,",") W ?($S(NURS132:98,1:52)+((2-NX)*9)),YY S:X'>0 NYR(YR(NX))="E"
S MC(1)=1 Q
HDR I '$G(NUROUT) I 'FSW,$E(IOST)="C" D ENDPG^NURSUT1 Q:$G(NUROUT)
S FSW=0,NURPAGE=NURPAGE+1
W:$E(IOST)="C"!(NURPAGE>1) @IOF
I NURMDSW,$G(NWRD)="" W !?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
W !,"3 "_$S(TYP="C":"CY ",1:"FY ")_$S(NURSEL="M":"MANDATORY",NURSEL="O":" OTHER",NURSEL="W":" WARD",NURSEL="C":"C.E.",1:" COMPLETE")_" TRAINING REPORT BY "_$S($G(NURSEL(1))=2:"SVC. CATEGORY",1:"UNIT"),?$S(NURS132:100,1:52)," ",NDATE
W ?$S(NURS132:121,1:69),"PAGE: ",NURPAGE,!!,$S(NURS132:"EMPLOYEE NAME",1:"EMPLOYEE NAME/CLASS") W:NURS132 ?37,"CLASS"
I NURS132 W ?92," "
I 'NURS132 W ?46," "
F X=2:-1:0 S YR(X)=$E("000000"_YR(X),$L(YR(X)),$L(YR(X))+6),Z=1700+$E(YR(X),1,3) W " ",Z
W !,HH
I $G(NURSPEC)'="" W !,$S($G(NURSEL(1))=2:"Service Category: ",1:"Unit: "),$S(NURSPEC'=" BLANK":NURSPEC,1:""),!
I $G(NURPLSW) N Z S Z=$$PROD^NURSUT2(NURPROG) W !,?$$CNTR^NURSUT2(NURPROG),$G(Z),!,?$$CNTR^NURSUT2(NURPROG),$$REPEAT^XLFSTR("-",$L(Z)+1)
Q
PHDR I $Y>(IOSL-4) D HDR W ! Q:$G(NUROUT)
CHDR W:NURS132 ?37,$E(MC,1,53) W:'NURS132 ?2,$E(MC,1,48)
Q
SORT Q:NURSZAP>7&(NURSZDA'=NDA) S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP Q:'NURSZORT
S NURNEN=$S($G(NURSEL(1))=2:1,1:3) D SETFAC^NURAAGS1,SETPROG^NURAAGS1
S NAM="VA # "_NDA I $D(^VA(200,NDA,0)),$P(^(0),U)'="" S NAM=$P(^(0),U)
S LOC=$S($D(^NURSF(211.8,+NURNODE4,0)):$P(^(0),U),1:"")
S NPWARD=LOC D EN7^NURSAUTL S LOC1=$S(NPWARD'="":$E(NPWARD,1,10),1:" BLANK")
D EN2^NURSUT0 Q:$G(NPSPOS(1))="" S SP=$$CAT^NURSUT2(NPSPOS(1))
I $G(NURHOSP)=0,'$D(NURSNLOC(LOC1)) Q
I $G(NURSEL(1))=2,'$D(^TMP("NURSCAT",$J,NPSPOS(1))) 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)
K NYR S NIC2="" F S NIC2=$O(^PRSE(452,"AA",NIC2)) Q:NIC2="" S MIC="" F S MIC=$O(^PRSE(452,"AA",NIC2,NDA,MIC)) Q:MIC="" D A
Q:$G(NURSPEC)=""
S:$D(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),NURSPEC,NAM)) ^(NAM)=^(NAM)_U_NURSPEC(1) Q
A F MIC(0)=0:0 S MIC(0)=$O(^PRSE(452,"AA",NIC2,NDA,MIC,MIC(0))) Q:MIC(0)'>0 F DA(2)=0:0 S DA(2)=$O(^PRSE(452,"AA",NIC2,NDA,MIC,MIC(0),DA(2))) Q:DA(2)'>0 D SORT1
;S:$D(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),LOC1,NAM)) ^(NAM)=^(NAM)_U_SP Q
SORT1 ;
S:$G(NURSORT)="" NURSORT=1
I NURSEL'="A"&(NURSEL'=NIC2) Q
S MICD=9999999-MIC(0),X=MICD S:NURSEL="A" NSPC=MIC D COMPARE S MICY=Y
Q:'$D(YR0(MICY)) I 'NSP,NSPC'=MIC Q
S NYR(MIC,MICY)=$S('$D(NYR(MIC,MICY)):0,1:NYR(MIC,MICY))+1
S NURSPEC=$S($G(NURSEL(1))=2:SP,1:LOC1),NURSPEC(1)=$S($G(NURSEL(1))=2:LOC1,1:SP)
N X S X=$G(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),NURSPEC,NAM))
I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),NURSPEC,NAM)=X
S ^TMP("NURE",$J,"L1",X,NDA,MIC)=NURSPEC(1)
S ^TMP("NURE",$J,2,NDA,MIC,MICY,NYR(MIC,MICY))=MICD
Q
COMPARE ;CHECK FOR NEW FISCAL YEAR
S Y=$E(X,1,3)_"0000" I X'<($E(X,1,3)_"1000"),TYP="F" S Y=Y+10000
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSEP31 6183 printed Dec 13, 2024@02:21:59 Page 2
NURSEP31 ;HIRMFO/JH,FT-NURSING MANDATORY INSERVICE CLASS DATA FOR THE LAST THREE YEARS ;3/19/98 13:17
+1 ;;4.0;NURSING SERVICE;**2,3,10,9**;Apr 25, 1997
EN1 SET X=$GET(^PRSE(452.7,1,"OFF"))
if X=""!(X=1)
QUIT
+1 SET X=$GET(^DIC(213.9,1,"OFF"))
if X=""!(X=1)
QUIT
+2 SET (NUSW,NSP,NURQUIT,NUROUT)=0
SET YRSW=1
DO EN1^NURSAUTL
if $GET(NUROUT)
GOTO QUIT
+3 IF NURPLSW=1
DO EN13^NURSAGSP
if $GET(NUROUT)
GOTO QUIT
+4 IF NURMDSW
SET DIC(0)="AEQZ"
SET NURPLSCR=1
DO EN5^NURSAGSP
if $GET(NUROUT)
GOTO QUIT
+5 IF NURMDSW=0
IF NURPLSW=1
SET NURPLSCR=1
DO PRD^NURSAGSP
KILL NURPLSCR
IF $GET(NUROUT)
GOTO QUIT
+6 DO EN10^NURSUT3($GET(DUZ))
WRITE !
SET DATSEL="NS^N+"
DO DATSEL^NURSAGP2
if $GET(NUROUT)
GOTO QUIT
+7 IF NURPLSW=0!($GET(NURSEL(1))=1)!($GET(NURSEL(1))="")
WRITE !
DO EN1^NURSAGSP
if $GET(NUROUT)
GOTO QUIT
+8 IF NURPLSW=1
IF $GET(NURSEL(1))=2
WRITE !
DO EN3^NURSAGSP
if $GET(NUROUT)
GOTO QUIT
+9 DO INS^NURSAGP2
if $GET(NUROUT)
GOTO QUIT
DO EN5^NURSAGP1
if $GET(NUROUT)
GOTO QUIT
+10 WRITE !
SET ZTDESC="Nursing Mandatory Inservice - last 3 years"
SET ZTRTN="START^NURSEP31"
DO EN7^NURSUT0
if POP!($DATA(ZTSK))
GOTO QUIT
START ;
+1 SET NURS132=$SELECT(IOM'<132:1,1:0)
SET NURPAGE=0
SET HH=""
SET $PIECE(HH,"-",$SELECT(NURS132:133,1:81))=""
SET (SLOC,SNM,SIEN,SMC,NOIEN,NOLOC,NOMIC1,NYR)=""
SET FSW=1
SET Y=DT
XECUTE ^DD("DD")
SET NDATE=Y
+2 KILL ^TMP("NURE",$JOB)
SET X=YRST
DO COMPARE
SET YR=Y
FOR Y=0:1:2
SET YR(Y)=YR-(Y*10000)
SET YR0(YR-(Y*10000))=""
+3 FOR NDA=0:0
SET NDA=$ORDER(^NURSF(211.8,"C",NDA))
if NDA'>0
QUIT
FOR NURNODE4=0:0
SET NURNODE4=$ORDER(^NURSF(211.8,"C",NDA,NURNODE4))
if NURNODE4'>0
QUIT
Begin DoDot:1
+4 FOR NURNODE5=0:0
SET NURNODE5=$ORDER(^NURSF(211.8,"C",NDA,NURNODE4,NURNODE5))
if NURNODE5'>0
QUIT
IF $DATA(^NURSF(211.8,NURNODE4,1,NURNODE5,0))
IF $PIECE(^(0),U)'>DT&(('$PIECE(^(0),U,6))!($PIECE(^(0),U,6)'<DT))
Begin DoDot:2
+5 SET DA=$ORDER(^NURSF(210,"B",NDA,0))
IF $PIECE($GET(^NURSF(210,+DA,0)),U,2)'=""
IF $PIECE($GET(^(0)),U,2)'="R"
if $RANDOM(500)&($EXTRACT(IOST)="C")
WRITE "."
DO SORT
End DoDot:2
End DoDot:1
+6 USE IO
if NURSZAP=7
DO EN4^NURSEP3I
SET NWRD("F")=$ORDER(NURSNLOC(""))
+7 IF '$DATA(^TMP("NURE",$JOB))
SET (MC,NM,IEN,LOC,SP)=""
SET NURFAC=$SELECT($GET(NURFAC)=0:$GET(NURFAC(1)),1:"")
SET NURPROG=$SELECT($GET(NURPROG)=0:$GET(NURPROG(1)),1:"")
DO HDR
WRITE !,"THERE IS NO DATA FOR THIS REPORT."
GOTO QUIT
+8 SET NURFAC=""
+9 FOR
SET NURFAC=$ORDER(^TMP("NURE",$JOB,"L",NURFAC))
if NURFAC=""
QUIT
SET NURPROG=""
FOR
SET NURPROG=$ORDER(^TMP("NURE",$JOB,"L",NURFAC,NURPROG))
if NURPROG=""
QUIT
SET NURSPEC=""
FOR
SET NURSPEC=$ORDER(^TMP("NURE",$JOB,"L",NURFAC,NURPROG,NURSPEC))
if NURSPEC=""!$GET(NUROUT)
QUIT
Begin DoDot:1
+10 DO HDR
if $GET(NUROUT)
QUIT
+11 SET NM=""
FOR
SET NM=$ORDER(^TMP("NURE",$JOB,"L",NURFAC,NURPROG,NURSPEC,NM))
if NM=""!$GET(NUROUT)
QUIT
SET NURSORT=$GET(^(NM))
SET NURSPEC(1)=$PIECE(NURSORT,U,2)
SET NURSORT=+NURSORT
IF NURSORT
SET IEN=""
FOR
SET IEN=$ORDER(^TMP("NURE",$JOB,"L1",NURSORT,IEN))
if IEN=""!$GET(NUROUT)
QUIT
DO FIN
End DoDot:1
QUIT KILL ^TMP("NURE",$JOB)
DO CLOSE^NURSUT1
DO ^NURSKILL
+1 QUIT
FIN if $Y>(IOSL-4)
DO HDR
if $GET(NUROUT)
QUIT
WRITE !,NM_" "_NURSPEC(1),!
SET MC=""
FOR
SET MC=$ORDER(^TMP("NURE",$JOB,"L1",NURSORT,IEN,MC))
if MC=""!$GET(NUROUT)
QUIT
DO FIN1
if $GET(NUROUT)
QUIT
+1 QUIT
FIN1 ;
+1 DO PHDR
if $GET(NUROUT)
QUIT
SET MC(1)=0
FOR X=0:1:2
SET NYR(YR(X))=0
+2 FOR I=0:0
DO FIN2
if $GET(NUROUT)
QUIT
WRITE !
if NYR(YR(1))="E"&(NYR(YR(0))="E")&(NYR(YR(2))="E")
QUIT
+3 QUIT
FIN2 IF MC(1)&($Y>(IOSL-4))
DO HDR
if NUROUT
QUIT
WRITE !
DO CHDR
if $GET(NUROUT)
QUIT
+1 FOR NX=2:-1:0
IF NYR(YR(NX))'="E"
SET NYR(YR(NX))=$ORDER(^TMP("NURE",$JOB,2,IEN,MC,YR(NX),NYR(YR(NX))))
if NYR(YR(NX))'>0
SET NYR(YR(NX))="E"
IF NYR(YR(NX))'="E"
DO FIN3
+2 QUIT
FIN3 SET Y=$EXTRACT(^TMP("NURE",$JOB,2,IEN,MC,YR(NX),NYR(YR(NX))),1,7)
SET X=$ORDER(^(NYR(YR(NX))))
DO D^DIQ
SET YY=$PIECE(Y,",")
WRITE ?($SELECT(NURS132:98,1:52)+((2-NX)*9)),YY
if X'>0
SET NYR(YR(NX))="E"
+1 SET MC(1)=1
QUIT
HDR IF '$GET(NUROUT)
IF 'FSW
IF $EXTRACT(IOST)="C"
DO ENDPG^NURSUT1
if $GET(NUROUT)
QUIT
+1 SET FSW=0
SET NURPAGE=NURPAGE+1
+2 if $EXTRACT(IOST)="C"!(NURPAGE>1)
WRITE @IOF
+3 IF NURMDSW
IF $GET(NWRD)=""
WRITE !?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
+4 WRITE !,"3 "_$SELECT(TYP="C":"CY ",1:"FY ")_$SELECT(NURSEL="M":"MANDATORY",NURSEL="O":" OTHER",NURSEL="W":" WARD",NURSEL="C":"C.E.",1:" COMPLETE")_" TRAINING REPORT BY "_$SELECT($GET(NURSEL(1))=2:"SVC. CATEGORY",1:"UNIT"),?...
... $SELECT(NURS132:100,1:52)," ",NDATE
+5 WRITE ?$SELECT(NURS132:121,1:69),"PAGE: ",NURPAGE,!!,$SELECT(NURS132:"EMPLOYEE NAME",1:"EMPLOYEE NAME/CLASS")
if NURS132
WRITE ?37,"CLASS"
+6 IF NURS132
WRITE ?92," "
+7 IF 'NURS132
WRITE ?46," "
+8 FOR X=2:-1:0
SET YR(X)=$EXTRACT("000000"_YR(X),$LENGTH(YR(X)),$LENGTH(YR(X))+6)
SET Z=1700+$EXTRACT(YR(X),1,3)
WRITE " ",Z
+9 WRITE !,HH
+10 IF $GET(NURSPEC)'=""
WRITE !,$SELECT($GET(NURSEL(1))=2:"Service Category: ",1:"Unit: "),$SELECT(NURSPEC'=" BLANK":NURSPEC,1:""),!
+11 IF $GET(NURPLSW)
NEW Z
SET Z=$$PROD^NURSUT2(NURPROG)
WRITE !,?$$CNTR^NURSUT2(NURPROG),$GET(Z),!,?$$CNTR^NURSUT2(NURPROG),$$REPEAT^XLFSTR("-",$LENGTH(Z)+1)
+12 QUIT
PHDR IF $Y>(IOSL-4)
DO HDR
WRITE !
if $GET(NUROUT)
QUIT
CHDR if NURS132
WRITE ?37,$EXTRACT(MC,1,53)
if 'NURS132
WRITE ?2,$EXTRACT(MC,1,48)
+1 QUIT
SORT if NURSZAP>7&(NURSZDA'=NDA)
QUIT
SET NURSZORT=1
if NURSZAP>6
DO EN3^NURSAUTL
if NURSZORT&NURSZAP
DO EN2^NURSAUTL
if 'NURSZORT
QUIT
+1 SET NURNEN=$SELECT($GET(NURSEL(1))=2:1,1:3)
DO SETFAC^NURAAGS1
DO SETPROG^NURAAGS1
+2 SET NAM="VA # "_NDA
IF $DATA(^VA(200,NDA,0))
IF $PIECE(^(0),U)'=""
SET NAM=$PIECE(^(0),U)
+3 SET LOC=$SELECT($DATA(^NURSF(211.8,+NURNODE4,0)):$PIECE(^(0),U),1:"")
+4 SET NPWARD=LOC
DO EN7^NURSAUTL
SET LOC1=$SELECT(NPWARD'="":$EXTRACT(NPWARD,1,10),1:" BLANK")
+5 DO EN2^NURSUT0
if $GET(NPSPOS(1))=""
QUIT
SET SP=$$CAT^NURSUT2(NPSPOS(1))
+6 IF $GET(NURHOSP)=0
IF '$DATA(NURSNLOC(LOC1))
QUIT
+7 IF $GET(NURSEL(1))=2
IF '$DATA(^TMP("NURSCAT",$JOB,NPSPOS(1)))
QUIT
+8 IF NURMDSW
IF '$GET(NURFAC)
IF $GET(NURFAC(1))'=$GET(NURFAC(2))
QUIT
+9 IF NURPLSW
IF '$GET(NURPROG)
IF $GET(NURPROG(1))'=$GET(NURPROG(2))
QUIT
+10 if NURPROG(2)="NURSING"
SET NURPROG(2)=" "_NURPROG(2)
+11 KILL NYR
SET NIC2=""
FOR
SET NIC2=$ORDER(^PRSE(452,"AA",NIC2))
if NIC2=""
QUIT
SET MIC=""
FOR
SET MIC=$ORDER(^PRSE(452,"AA",NIC2,NDA,MIC))
if MIC=""
QUIT
DO A
+12 if $GET(NURSPEC)=""
QUIT
+13 if $DATA(^TMP("NURE",$JOB,"L",NURFAC(2),NURPROG(2),NURSPEC,NAM))
SET ^(NAM)=^(NAM)_U_NURSPEC(1)
QUIT
A FOR MIC(0)=0:0
SET MIC(0)=$ORDER(^PRSE(452,"AA",NIC2,NDA,MIC,MIC(0)))
if MIC(0)'>0
QUIT
FOR DA(2)=0:0
SET DA(2)=$ORDER(^PRSE(452,"AA",NIC2,NDA,MIC,MIC(0),DA(2)))
if DA(2)'>0
QUIT
DO SORT1
+1 ;S:$D(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),LOC1,NAM)) ^(NAM)=^(NAM)_U_SP Q
SORT1 ;
+1 if $GET(NURSORT)=""
SET NURSORT=1
+2 IF NURSEL'="A"&(NURSEL'=NIC2)
QUIT
+3 SET MICD=9999999-MIC(0)
SET X=MICD
if NURSEL="A"
SET NSPC=MIC
DO COMPARE
SET MICY=Y
+4 if '$DATA(YR0(MICY))
QUIT
IF 'NSP
IF NSPC'=MIC
QUIT
+5 SET NYR(MIC,MICY)=$SELECT('$DATA(NYR(MIC,MICY)):0,1:NYR(MIC,MICY))+1
+6 SET NURSPEC=$SELECT($GET(NURSEL(1))=2:SP,1:LOC1)
SET NURSPEC(1)=$SELECT($GET(NURSEL(1))=2:LOC1,1:SP)
+7 NEW X
SET X=$GET(^TMP("NURE",$JOB,"L",NURFAC(2),NURPROG(2),NURSPEC,NAM))
+8 IF X=""
SET X=NURSORT
SET NURSORT=NURSORT+1
SET ^TMP("NURE",$JOB,"L",NURFAC(2),NURPROG(2),NURSPEC,NAM)=X
+9 SET ^TMP("NURE",$JOB,"L1",X,NDA,MIC)=NURSPEC(1)
+10 SET ^TMP("NURE",$JOB,2,NDA,MIC,MICY,NYR(MIC,MICY))=MICD
+11 QUIT
COMPARE ;CHECK FOR NEW FISCAL YEAR
+1 SET Y=$EXTRACT(X,1,3)_"0000"
IF X'<($EXTRACT(X,1,3)_"1000")
IF TYP="F"
SET Y=Y+10000
+2 QUIT
