- NURSEP3I ;HIRMFO/GLB,JH,FT-INDIVIDUAL NURSING MANDATORY INSERVICE CLASS DATA FOR THE LAST THREE YEARS ;2/27/98 14:26
- ;;4.0;NURSING SERVICE;**9**;Apr 25, 1997
- EN1 S X=$G(^PRSE(452.7,1,"OFF")) Q:X=""!(X=1)
- S Y=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
- S (NUSW,NSP,NURQUEUE,NUROUT)=0,YRSW=1
- S DATSEL="NS^N+" D DATSEL^NURSAGP2 G QUIT:NUROUT W ! D INS^NURSAGP2 G QUIT:NUROUT D:NURSEL'="A" EN5^NURSAGP1 G QUIT:NUROUT
- D EN1^NURSAUTL G QUIT:NUROUT D EN10^NURSUT3($G(DUZ)) I $G(NURSZAP)>7 S DA=$O(^NURSF(210,"B",DUZ,0)),DA(1)=DUZ G A1
- S DIC("S")="I +$$EN6^NURSUT3($G(Y))"
- D EN3^NURSAGP1 G QUIT:NUROUT S DA=+Y,DA(1)=+$G(^NURSF(210,DA,0))
- A1 W ! S ZTRTN="START^NURSEP3I" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- K ^TMP("NURE",$J) S NURS132=$S(IOM'<132:1,1:0),$P(HH,"-",$S(NURS132:133,1:81))="",(CLASS,NURPAGE)=0,(NOIEN,NOLOC,NOMIC1,NYR,SLOC,SNM,SIEN,SMC)="",FSW=1
- S X=YRST D COMPARE S YR=Y F Y=0:1:2 S YR(Y)=YR-(Y*10000),YR0(YR-(Y*10000))=""
- K NYR D SORT
- S LOC=""
- F S LOC=$O(^TMP("NURE",$J,"L",LOC)) Q:LOC=""!NUROUT S NM="" F S NM=$O(^TMP("NURE",$J,"L",LOC,NM)) Q:NM=""!NUROUT S NURSORT=$G(^TMP("NURE",$J,"L",LOC,NM)) I NURSORT F IEN=0:0 S IEN=$O(^TMP("NURE",$J,"L1",NURSORT,IEN)) Q:IEN'>0!NUROUT D FIN
- I 'NURPAGE D HDR W !!,"THERE IS NO SELECTED INSERVICE DATA."
- QUIT ;
- K ^TMP("NURE",$J) D CLOSE^NURSUT1,^NURSKILL
- Q
- FIN S MC="" F S MC=$O(^TMP("NURE",$J,"L1",NURSORT,IEN,MC)) Q:MC=""!NUROUT D FIN1
- Q
- FIN1 S SP=$P(^TMP("NURE",$J,"L1",NURSORT,IEN,MC),"^")
- I $Y>(IOSL-4)!(FSW) D HDR Q:NUROUT
- I NOIEN'=IEN D PHDR
- I NOMIC1'=MC D CHDR
- F X=0:1:2 S NYR(YR(X))=0
- F I=0:0 D FIN2 W ! Q:NYR(YR(1))="E"&(NYR(YR(0))="E")&(NYR(YR(2))="E") I ($Y>(IOSL-4)) D HDR Q:NUROUT
- Q
- FIN2 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:88,1:52)+((2-NX)*9)),YY S:X'>0 NYR(YR(NX))="E"
- Q
- HDR I 'NUROUT I 'FSW,$E(IOST)="C" D ENDPG^NURSUT1 Q:$G(NUROUT)
- S FSW=0,NOLOC=LOC,NURPAGE=NURPAGE+1
- W:$E(IOST)="C"!(NURPAGE>1) @IOF
- W !,"3 "_$S(TYP="C":"CY ",1:"FY ")_"INDIVIDUAL "_$S(NURSEL="M":"MANDATORY",NURSEL="O":"OTHER",NURSEL="W":"WARD",NURSEL="C":"C.E.",1:"COMPLETE")_" TRAINING REPORT",?$S(NURS132:100,1:52)," "
- S Y=DT D DT^DIQ
- W ?$S(NURS132:121,1:69),"PAGE: ",NURPAGE,!!,"CLASS"
- I NURS132 W ?82," "
- I 'NURS132 W ?46," "
- F X=2:-1:0 S Z=1700+$E(YR(X),1,3) W " ",Z
- W !,HH Q:NUROUT!($G(IEN)="")
- PHDR S NOIEN=IEN W !,"Employee Name: "_NM_" "_SP,!!
- CHDR S NOMIC1=MC W $S(NURS132:MC,1:$E(MC,1,50))
- Q
- SORT S NAM=" BLANK" I $D(^VA(200,DA(1),0)),$P(^(0),"^",1)'="" S NAM=$P(^(0),"^",1)
- D EN3^NURSUT0 S LOC=$S('$D(^NURSF(211.8,+NOD1,0)):" BLANK",'+$P(^(0),U):" BLANK",1:$P(^(0),U))
- S NPWARD=LOC D EN7^NURSAUTL S LOC1=$S(NPWARD'="":NPWARD,1:" BLANK")
- D EN2^NURSUT0 S SP=NPSPOS(1),SP=$S(SP="R":"RN",SP="L":"LPN",SP="N":"NA",SP="C":"CK",SP="S":"SE",SP="A":"AO",SP="O":"OT",1:" ")
- S NIC2="" F S NIC2=$O(^PRSE(452,"AA",NIC2)) Q:NIC2="" S MIC="" F S MIC=$O(^PRSE(452,"AA",NIC2,DA(1),MIC)) Q:MIC="" W:$E(IOST)="C" "." D A
- Q
- A F MIC(0)=0:0 S MIC(0)=$O(^PRSE(452,"AA",NIC2,DA(1),MIC,MIC(0))) Q:MIC(0)'>0 F MIC(1)=0:0 S MIC(1)=$O(^PRSE(452,"AA",NIC2,DA(1),MIC,MIC(0),MIC(1))) Q:MIC(1)'>0 D SORT2
- Q
- SORT2 ;
- 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
- N X S X=$G(^TMP("NURE",$J,"L",LOC1,NAM))
- I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP("NURE",$J,"L",LOC1,NAM)=X
- S ^TMP("NURE",$J,"L1",X,DA,MIC)=SP
- S ^TMP("NURE",$J,2,DA,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
- EN4 ; SCREEN OUT UNAUTHORIZED LOCATION DATA
- S X="" F Y=0:0 S X=$O(^TMP("NURE",$J,1,X)) Q:X="" S Z="" F Y=0:0 S Z=$O(^SC("B",$S(X'?1"NUR ":"NUR ",1:"")_X,Z)) Q:Z'>0 S Y=$O(^NURSF(211.4,"B",Z,"")) K:$S(Y'>0:0,'$D(NURSZLO(Y)):1,1:0) ^TMP("NURE",$J,1,X)
- K X,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSEP3I 4201 printed Jan 18, 2025@03:23:10 Page 2
- NURSEP3I ;HIRMFO/GLB,JH,FT-INDIVIDUAL NURSING MANDATORY INSERVICE CLASS DATA FOR THE LAST THREE YEARS ;2/27/98 14:26
- +1 ;;4.0;NURSING SERVICE;**9**;Apr 25, 1997
- EN1 SET X=$GET(^PRSE(452.7,1,"OFF"))
- if X=""!(X=1)
- QUIT
- +1 SET Y=$GET(^DIC(213.9,1,"OFF"))
- if X=""!(X=1)
- QUIT
- +2 SET (NUSW,NSP,NURQUEUE,NUROUT)=0
- SET YRSW=1
- +3 SET DATSEL="NS^N+"
- DO DATSEL^NURSAGP2
- if NUROUT
- GOTO QUIT
- WRITE !
- DO INS^NURSAGP2
- if NUROUT
- GOTO QUIT
- if NURSEL'="A"
- DO EN5^NURSAGP1
- if NUROUT
- GOTO QUIT
- +4 DO EN1^NURSAUTL
- if NUROUT
- GOTO QUIT
- DO EN10^NURSUT3($GET(DUZ))
- IF $GET(NURSZAP)>7
- SET DA=$ORDER(^NURSF(210,"B",DUZ,0))
- SET DA(1)=DUZ
- GOTO A1
- +5 SET DIC("S")="I +$$EN6^NURSUT3($G(Y))"
- +6 DO EN3^NURSAGP1
- if NUROUT
- GOTO QUIT
- SET DA=+Y
- SET DA(1)=+$GET(^NURSF(210,DA,0))
- A1 WRITE !
- SET ZTRTN="START^NURSEP3I"
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 KILL ^TMP("NURE",$JOB)
- SET NURS132=$SELECT(IOM'<132:1,1:0)
- SET $PIECE(HH,"-",$SELECT(NURS132:133,1:81))=""
- SET (CLASS,NURPAGE)=0
- SET (NOIEN,NOLOC,NOMIC1,NYR,SLOC,SNM,SIEN,SMC)=""
- SET FSW=1
- +2 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 KILL NYR
- DO SORT
- +4 SET LOC=""
- +5 FOR
- SET LOC=$ORDER(^TMP("NURE",$JOB,"L",LOC))
- if LOC=""!NUROUT
- QUIT
- SET NM=""
- FOR
- SET NM=$ORDER(^TMP("NURE",$JOB,"L",LOC,NM))
- if NM=""!NUROUT
- QUIT
- SET NURSORT=$GET(^TMP("NURE",$JOB,"L",LOC,NM))
- IF NURSORT
- FOR IEN=0:0
- SET IEN=$ORDER(^TMP("NURE",$JOB,"L1",NURSORT,IEN))
- if IEN'>0!NUROUT
- QUIT
- DO FIN
- +6 IF 'NURPAGE
- DO HDR
- WRITE !!,"THERE IS NO SELECTED INSERVICE DATA."
- QUIT ;
- +1 KILL ^TMP("NURE",$JOB)
- DO CLOSE^NURSUT1
- DO ^NURSKILL
- +2 QUIT
- FIN SET MC=""
- FOR
- SET MC=$ORDER(^TMP("NURE",$JOB,"L1",NURSORT,IEN,MC))
- if MC=""!NUROUT
- QUIT
- DO FIN1
- +1 QUIT
- FIN1 SET SP=$PIECE(^TMP("NURE",$JOB,"L1",NURSORT,IEN,MC),"^")
- +1 IF $Y>(IOSL-4)!(FSW)
- DO HDR
- if NUROUT
- QUIT
- +2 IF NOIEN'=IEN
- DO PHDR
- +3 IF NOMIC1'=MC
- DO CHDR
- +4 FOR X=0:1:2
- SET NYR(YR(X))=0
- +5 FOR I=0:0
- DO FIN2
- WRITE !
- if NYR(YR(1))="E"&(NYR(YR(0))="E")&(NYR(YR(2))="E")
- QUIT
- IF ($Y>(IOSL-4))
- DO HDR
- if NUROUT
- QUIT
- +6 QUIT
- FIN2 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
- +1 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:88,1:52)+((2-NX)*9)),YY
- if X'>0
- SET NYR(YR(NX))="E"
- +1 QUIT
- HDR IF 'NUROUT
- IF 'FSW
- IF $EXTRACT(IOST)="C"
- DO ENDPG^NURSUT1
- if $GET(NUROUT)
- QUIT
- +1 SET FSW=0
- SET NOLOC=LOC
- SET NURPAGE=NURPAGE+1
- +2 if $EXTRACT(IOST)="C"!(NURPAGE>1)
- WRITE @IOF
- +3 WRITE !,"3 "_$SELECT(TYP="C":"CY ",1:"FY ")_"INDIVIDUAL "_$SELECT(NURSEL="M":"MANDATORY",NURSEL="O":"OTHER",NURSEL="W":"WARD",NURSEL="C":"C.E.",1:"COMPLETE")_" TRAINING REPORT",?$SELECT(NURS132:100,1:52)," "
- +4 SET Y=DT
- DO DT^DIQ
- +5 WRITE ?$SELECT(NURS132:121,1:69),"PAGE: ",NURPAGE,!!,"CLASS"
- +6 IF NURS132
- WRITE ?82," "
- +7 IF 'NURS132
- WRITE ?46," "
- +8 FOR X=2:-1:0
- SET Z=1700+$EXTRACT(YR(X),1,3)
- WRITE " ",Z
- +9 WRITE !,HH
- if NUROUT!($GET(IEN)="")
- QUIT
- PHDR SET NOIEN=IEN
- WRITE !,"Employee Name: "_NM_" "_SP,!!
- CHDR SET NOMIC1=MC
- WRITE $SELECT(NURS132:MC,1:$EXTRACT(MC,1,50))
- +1 QUIT
- SORT SET NAM=" BLANK"
- IF $DATA(^VA(200,DA(1),0))
- IF $PIECE(^(0),"^",1)'=""
- SET NAM=$PIECE(^(0),"^",1)
- +1 DO EN3^NURSUT0
- SET LOC=$SELECT('$DATA(^NURSF(211.8,+NOD1,0)):" BLANK",'+$PIECE(^(0),U):" BLANK",1:$PIECE(^(0),U))
- +2 SET NPWARD=LOC
- DO EN7^NURSAUTL
- SET LOC1=$SELECT(NPWARD'="":NPWARD,1:" BLANK")
- +3 DO EN2^NURSUT0
- SET SP=NPSPOS(1)
- SET SP=$SELECT(SP="R":"RN",SP="L":"LPN",SP="N":"NA",SP="C":"CK",SP="S":"SE",SP="A":"AO",SP="O":"OT",1:" ")
- +4 SET NIC2=""
- FOR
- SET NIC2=$ORDER(^PRSE(452,"AA",NIC2))
- if NIC2=""
- QUIT
- SET MIC=""
- FOR
- SET MIC=$ORDER(^PRSE(452,"AA",NIC2,DA(1),MIC))
- if MIC=""
- QUIT
- if $EXTRACT(IOST)="C"
- WRITE "."
- DO A
- +5 QUIT
- A FOR MIC(0)=0:0
- SET MIC(0)=$ORDER(^PRSE(452,"AA",NIC2,DA(1),MIC,MIC(0)))
- if MIC(0)'>0
- QUIT
- FOR MIC(1)=0:0
- SET MIC(1)=$ORDER(^PRSE(452,"AA",NIC2,DA(1),MIC,MIC(0),MIC(1)))
- if MIC(1)'>0
- QUIT
- DO SORT2
- +1 QUIT
- SORT2 ;
- +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 NEW X
- SET X=$GET(^TMP("NURE",$JOB,"L",LOC1,NAM))
- +7 IF X=""
- SET X=NURSORT
- SET NURSORT=NURSORT+1
- SET ^TMP("NURE",$JOB,"L",LOC1,NAM)=X
- +8 SET ^TMP("NURE",$JOB,"L1",X,DA,MIC)=SP
- +9 SET ^TMP("NURE",$JOB,2,DA,MIC,MICY,NYR(MIC,MICY))=MICD
- +10 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
- EN4 ; SCREEN OUT UNAUTHORIZED LOCATION DATA
- +1 SET X=""
- FOR Y=0:0
- SET X=$ORDER(^TMP("NURE",$JOB,1,X))
- if X=""
- QUIT
- SET Z=""
- FOR Y=0:0
- SET Z=$ORDER(^SC("B",$SELECT(X'?1"NUR ":"NUR ",1:"")_X,Z))
- if Z'>0
- QUIT
- SET Y=$ORDER(^NURSF(211.4,"B",Z,""))
- if $SELECT(Y'>0
- KILL ^TMP("NURE",$JOB,1,X)
- +2 KILL X,Y
- +3 QUIT