source: FOIAVistA/tag/r/NURSING_SERVICE-NUR/NURSEPD3.m@ 628

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1NURSEPD3 ;HIRMFO/MD-INCOMPLETE NURS M I REPORT (BY CLASS) PART 1 OF 2 ;8/19/97
2 ;;4.0;NURSING SERVICE;**3,10**;Apr 25, 1997
3 I $O(^TMP("NURE",$J,"SORT1",""))="" S NURFAC=$S($G(NURFAC)=0:$G(NURFAC(1)),1:""),NURPROG=$S($G(NURPROG)=0:$G(NURPROG(1)),1:"") D Q
4 .D HDR Q:NUROUT
5 .I 'NONE W !,"NO DEFICIENCIES FOUND FOR THIS TIME PERIOD." Q
6 .I NONE S NPWARD=$G(NWRD) D EN6^NURSAUTL W !,"Unit : "_$S($G(NPWARD)="":" ",1:NPWARD),!!,"NO GROUPS/CLASSES ARE ASSIGNED TO NURSING PERSONNEL",! Q
7 S NURFAC=""
8 F S NURFAC=$O(^TMP("NURE",$J,"SORT1",NURFAC)) Q:NURFAC="" S NURPROG="" F S NURPROG=$O(^TMP("NURE",$J,"SORT1",NURFAC,NURPROG)) Q:NURPROG="" S NURSPEC="" F S NURSPEC=$O(^TMP("NURE",$J,"SORT1",NURFAC,NURPROG,NURSPEC)) Q:NURSPEC=""!(NUROUT) D
9 .D HDR Q:NUROUT S TMP=$G(^TMP("NURE",$J,"%",NURFAC,NURPROG,NURSPEC)),COMPLIAN=""
10 .S TOT=$P(TMP,U),DEF=$P(TMP,U,2)
11 .S COMPLIAN=$S(TOT:100-(100*DEF/TOT),1:"")
12 .I 'NURSW1!($Y>(IOSL-5)) D HDR W ! Q:NUROUT
13 .D SUBHDR
14 .S NURSPEC(1)="" F S NURSPEC(1)=$O(^TMP("NURE",$J,"SORT1",NURFAC,NURPROG,NURSPEC,NURSPEC(1))) Q:NURSPEC(1)=""!(NUROUT) S HOLD=1 D S HOLD=1
15 ..S CLASSNUM=+$G(^TMP("NURE",$J,"SORT1",NURFAC,NURPROG,NURSPEC,NURSPEC(1))) Q:CLASSNUM'>0
16 ..S NAM="" F S NAM=$O(^TMP("NURE",$J,"SORT2",CLASSNUM,NAM)) Q:NAM=""!(NUROUT) S HOLD2=1 D W ! S HOLD2=1
17 ...S CLASSTXT="" F S CLASSTXT=$O(^TMP("NURE",$J,"SORT2",CLASSNUM,NAM,CLASSTXT)) Q:CLASSTXT=""!(NUROUT) D
18 ....I ($Y>(IOSL-5))!'(NURSW1) D HDR,SUBHDR W ! Q:NUROUT
19 ....I HOLD S NSCT(1)=$$CAT^NURSUT2(NURSPEC(1)) S HOLD=0
20 ....W:NAM'=" BLANK"&HOLD2=1 $S(NURS132:NAM,1:$E(NAM,1,25))_" "_$S(NSCT(1)=" BLANK":" ",1:NSCT(1)) S HOLD2=0
21 ....S DROPDEAD=$G(^TMP("NURE",$J,"SORT2",CLASSNUM,NAM,CLASSTXT))
22 ....W:$G(DROPDEAD)>0 ?$S(NURS132:50,1:35),$$FMTE^XLFDT(DROPDEAD,2)
23 ....W:CLASSTXT'=" BLANK" ?$S(NURS132:79,1:47),$S(NURS132:CLASSTXT,1:$E(CLASSTXT,1,33)),! S NURSW1=1
24 ....Q
25 ...Q
26 ..Q
27 .Q
28 Q
29HDR ; PRINT REPORT HEADER
30 I NURSW1,$E(IOST)="C" D ENDPG^NURSUT1 Q:NUROUT
31 S COUNT=COUNT+1,(NURSW1,HOLD,HOLD2)=1,NSW2=0
32 W:$E(IOST)="C"!(COUNT>1) @IOF
33 I NURMDSW,$G(NURFAC)'="" W !?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
34 W !,"MANDATORY DEFICIENCY REPORT BY "_$S($G(NURSEL(1))=2:"SVC. CATEGORY",1:"UNIT")_" FOR "_$S(TYP="C":"CY ",TYP="F":"FY ",1:" ")
35 W $S(TYP="C"!(TYP="F"):$G(NYR),1:$G(YRST(1))_" - "_$G(YREND(1)))
36 W ?$S(NURS132:101,1:58)," ",$$FMTE^XLFDT(DT,2),?$S(NURS132:121,1:71),"PAGE: ",COUNT
37 W !!,?$S(NURS132:50,1:35),"ANNIVERSARY"
38 W !,"EMPLOYEE NAME",?$S(NURS132:50,1:35),"DATE",?$S(NURS132:79,1:47),"CLASS"
39 W !,$$REPEAT^XLFSTR("_",$S(NURS132:132,1:80))
40PROD I $G(NURPLSW),$G(NURPROG)'="" N Z S Z=$$PROD^NURSUT2(NURPROG) W !,?$$CNTR^NURSUT2(Z),Z,!,?$$CNTR^NURSUT2(NURPROG),$$REPEAT^XLFSTR("-",$L(Z)+1)
41 Q
42SUBHDR ;
43 Q:NUROUT
44 W !,$S($G(NURSEL(1))=2:"Service Category: ",1:"Unit: ")_$S(NURSPEC=" BLANK":" ",1:NURSPEC)
45 ; %Compliance = 100% -( ( # of deficient persons on the unit/
46 ; # of persons on the unit ) * 100%)
47 W ?40,"% Compliance: ",$J(COMPLIAN,3,0) I COMPLIAN=100,$G(NSPC)]"" W ?$X+3,NSPC
48 W !!
49 Q
Note: See TracBrowser for help on using the repository browser.