VistA-WorldVistAEHR/r/NURSING_SERVICE-NUR/NURSEP31.m

86 lines
6.0 KiB
Mathematica

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