- 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 Jan 18, 2025@03:23:09 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