source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURSEP31.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.0 KB
Line 
1NURSEP31 ;HIRMFO/JH,FT-NURSING MANDATORY INSERVICE CLASS DATA FOR THE LAST THREE YEARS ;3/19/98 13:17
2 ;;4.0;NURSING SERVICE;**2,3,10,9**;Apr 25, 1997
3EN1 S X=$G(^PRSE(452.7,1,"OFF")) Q:X=""!(X=1)
4 S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
5 S (NUSW,NSP,NURQUIT,NUROUT)=0,YRSW=1 D EN1^NURSAUTL G QUIT:$G(NUROUT)
6 I NURPLSW=1 D EN13^NURSAGSP G QUIT:$G(NUROUT)
7 I NURMDSW S DIC(0)="AEQZ",NURPLSCR=1 D EN5^NURSAGSP G:$G(NUROUT) QUIT
8 I NURMDSW=0,NURPLSW=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
9 D EN10^NURSUT3($G(DUZ)) W ! S DATSEL="NS^N+" D DATSEL^NURSAGP2 G:$G(NUROUT) QUIT
10 I NURPLSW=0!($G(NURSEL(1))=1)!($G(NURSEL(1))="") W ! D EN1^NURSAGSP G QUIT:$G(NUROUT)
11 I NURPLSW=1,$G(NURSEL(1))=2 W ! D EN3^NURSAGSP G QUIT:$G(NUROUT)
12 D INS^NURSAGP2 G QUIT:$G(NUROUT) D EN5^NURSAGP1 G QUIT:$G(NUROUT)
13 W ! S ZTDESC="Nursing Mandatory Inservice - last 3 years",ZTRTN="START^NURSEP31" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
14START ;
15 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
16 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))=""
17 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
18 .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
19 ..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
20 U IO D:NURSZAP=7 EN4^NURSEP3I S NWRD("F")=$O(NURSNLOC(""))
21 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
22 S NURFAC=""
23 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
24 .D HDR Q:$G(NUROUT)
25 .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
26QUIT K ^TMP("NURE",$J) D CLOSE^NURSUT1,^NURSKILL
27 Q
28FIN 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)
29 Q
30FIN1 ;
31 D PHDR Q:$G(NUROUT) S MC(1)=0 F X=0:1:2 S NYR(YR(X))=0
32 F I=0:0 D FIN2 Q:$G(NUROUT) W ! Q:NYR(YR(1))="E"&(NYR(YR(0))="E")&(NYR(YR(2))="E")
33 Q
34FIN2 I MC(1)&($Y>(IOSL-4)) D HDR Q:NUROUT W ! D CHDR Q:$G(NUROUT)
35 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
36 Q
37FIN3 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"
38 S MC(1)=1 Q
39HDR I '$G(NUROUT) I 'FSW,$E(IOST)="C" D ENDPG^NURSUT1 Q:$G(NUROUT)
40 S FSW=0,NURPAGE=NURPAGE+1
41 W:$E(IOST)="C"!(NURPAGE>1) @IOF
42 I NURMDSW,$G(NWRD)="" W !?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
43 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
44 W ?$S(NURS132:121,1:69),"PAGE: ",NURPAGE,!!,$S(NURS132:"EMPLOYEE NAME",1:"EMPLOYEE NAME/CLASS") W:NURS132 ?37,"CLASS"
45 I NURS132 W ?92," "
46 I 'NURS132 W ?46," "
47 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
48 W !,HH
49 I $G(NURSPEC)'="" W !,$S($G(NURSEL(1))=2:"Service Category: ",1:"Unit: "),$S(NURSPEC'=" BLANK":NURSPEC,1:""),!
50 I $G(NURPLSW) N Z S Z=$$PROD^NURSUT2(NURPROG) W !,?$$CNTR^NURSUT2(NURPROG),$G(Z),!,?$$CNTR^NURSUT2(NURPROG),$$REPEAT^XLFSTR("-",$L(Z)+1)
51 Q
52PHDR I $Y>(IOSL-4) D HDR W ! Q:$G(NUROUT)
53CHDR W:NURS132 ?37,$E(MC,1,53) W:'NURS132 ?2,$E(MC,1,48)
54 Q
55SORT Q:NURSZAP>7&(NURSZDA'=NDA) S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP Q:'NURSZORT
56 S NURNEN=$S($G(NURSEL(1))=2:1,1:3) D SETFAC^NURAAGS1,SETPROG^NURAAGS1
57 S NAM="VA # "_NDA I $D(^VA(200,NDA,0)),$P(^(0),U)'="" S NAM=$P(^(0),U)
58 S LOC=$S($D(^NURSF(211.8,+NURNODE4,0)):$P(^(0),U),1:"")
59 S NPWARD=LOC D EN7^NURSAUTL S LOC1=$S(NPWARD'="":$E(NPWARD,1,10),1:" BLANK")
60 D EN2^NURSUT0 Q:$G(NPSPOS(1))="" S SP=$$CAT^NURSUT2(NPSPOS(1))
61 I $G(NURHOSP)=0,'$D(NURSNLOC(LOC1)) Q
62 I $G(NURSEL(1))=2,'$D(^TMP("NURSCAT",$J,NPSPOS(1))) Q
63 I NURMDSW,'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
64 I NURPLSW,'$G(NURPROG),$G(NURPROG(1))'=$G(NURPROG(2)) Q
65 S:NURPROG(2)="NURSING" NURPROG(2)=" "_NURPROG(2)
66 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
67 Q:$G(NURSPEC)=""
68 S:$D(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),NURSPEC,NAM)) ^(NAM)=^(NAM)_U_NURSPEC(1) Q
69A 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
70 ;S:$D(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),LOC1,NAM)) ^(NAM)=^(NAM)_U_SP Q
71SORT1 ;
72 S:$G(NURSORT)="" NURSORT=1
73 I NURSEL'="A"&(NURSEL'=NIC2) Q
74 S MICD=9999999-MIC(0),X=MICD S:NURSEL="A" NSPC=MIC D COMPARE S MICY=Y
75 Q:'$D(YR0(MICY)) I 'NSP,NSPC'=MIC Q
76 S NYR(MIC,MICY)=$S('$D(NYR(MIC,MICY)):0,1:NYR(MIC,MICY))+1
77 S NURSPEC=$S($G(NURSEL(1))=2:SP,1:LOC1),NURSPEC(1)=$S($G(NURSEL(1))=2:LOC1,1:SP)
78 N X S X=$G(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),NURSPEC,NAM))
79 I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),NURSPEC,NAM)=X
80 S ^TMP("NURE",$J,"L1",X,NDA,MIC)=NURSPEC(1)
81 S ^TMP("NURE",$J,2,NDA,MIC,MICY,NYR(MIC,MICY))=MICD
82 Q
83COMPARE ;CHECK FOR NEW FISCAL YEAR
84 S Y=$E(X,1,3)_"0000" I X'<($E(X,1,3)_"1000"),TYP="F" S Y=Y+10000
85 Q
Note: See TracBrowser for help on using the repository browser.