source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURA9A1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1NURA9A1 ;HIRMFO/JH/MD,FT-ACADEMIC DEGREE REPORT BY SVC. CATEGORY AND LOCATION ;8/8/96 13:53
2 ;;4.0;NURSING SERVICE;**13**;Apr 25, 1997
3CAT D HSKEEP G QUIT:$G(NUROUT)
4 D EN3^NURSAGSP G QUIT:$G(NUROUT)
5 D EN2^NURSAGP0 G QUIT:$G(NUROUT)
6 D DEV G:POP!($D(ZTSK)) QUIT
7START ;
8 K ^TMP($J),^TMP("NURA",$J),^TMP("NURLOC",$J) U IO S (NURPAGE,NURSW1,NURQUIT)=0,NURSSP="",$P(NURSSP," ",80)=" "
9 S NURSTIL="ACADEMIC EDUC. PROFILE BY LOCATION/SVC. CATEGORY",NURSTIL1=$E(NURSSP,1,17)_"SERVICE"_" "_"EMPLOYEE"_$E(NURSSP,1,15)_" HIGHEST"
10 S NURSTIL2="NO. LOCATION CATEGORY NAME"_$E(NURSSP,1,19)_" ACAD. DEGREE"
11 S NURROU=1,NRPT=1,NURSLEV=4 W ! D EN3^NURAAGS0,CHK G:$G(NUROUT) QUIT
12 D PRINT^NURAGEN G:NX="^" QUIT
13 S NURSORT(2)=3,NURSORT(3)="N(1)" D TOTALS
14 G QUIT
15POS ;ACADEMIC DEGREE REPORT BY SERVICE POSITION AND LOCATION
16 D HSKEEP G QUIT:$G(NUROUT)
17 W ! D EN2^NURSAGSP G QUIT:$G(NUROUT)
18 D EN2^NURSAGP0 G QUIT:$G(NUROUT)
19 D DEV G:POP!($D(ZTSK)) QUIT
20START1 ;
21 K ^TMP($J),^TMP("NURA",$J) U IO S (NURPAGE,NURSW1,NURQUIT)=0,NURSSP="",$P(NURSSP," ",132)=""
22 S NURSTIL="ACADEMIC EDUC. PROFILE BY LOCATION/SVC. POSITION",NURSTIL1=$E(NURSSP,1,17)_"SERVICE EMPLOYEE"_$E(NURSSP,1,16)_"HIGHEST"
23 S NURSTIL2="NO. LOCATION POSITION NAME"_$E(NURSSP,1,20)_"ACAD. DEGREE"
24 S NURROU=2,NRPT=1,NURSLEV=5 W ! D EN4^NURAAGS0,CHK G:$G(NUROUT) QUIT
25 D PRINT^NURAGEN G:NX="^" QUIT
26 D TOTALS
27 G QUIT
28DEV ;
29 S ZTDESC="Nursing Academic Education Profile by Location/Service "_$S(ANS2=1:"Category",1:"Position")
30 S ZTRTN=$S(ANS2=1:"START^NURA9A1",ANS2=2:"START1^NURA9A1") D EN7^NURSUT0
31 Q
32QUIT D CLOSE^NURSUT1,^NURAKILL
33 Q
34CHK D NODATA^NURAGEN
35 Q
36HSKEEP ;
37 D EN1^NURSAUTL Q:$G(NUROUT)
38 I NURMDSW S DIC(0)="AEQZ",NURPLSCR=1 D EN5^NURSAGSP Q:$G(NUROUT)
39 I NURMDSW=0,NURPLSW=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR Q:$G(NUROUT)
40 W ! D EN1^NURSAGSP
41 Q
42TOTALS ;
43 I $Y>(IOSL-6) D HEADER^NURAGEN
44 W !,?47,$$REPEAT^XLFSTR("-",33) D EN2^NURAED3 W !!,"TOTAL NUMBER OF ASSIGNMENTS ",?47,$J(NTCT,4,0),!!,"TOTAL NUMBER OF PERSONNEL",?47,$J(NTOT,4,0)
45 Q
Note: See TracBrowser for help on using the repository browser.