Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURSEP31

NURSEP31.m

Go to the documentation of this file.
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