source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSEPC0.m@ 1766

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1NURSEPC0 ;HIRMFO/PC,FT-C.E.PROGRAM ATTENDANCE SUMMARY,PRINT CON'T ;5/9/97
2 ;;4.0;NURSING SERVICE;**1**;Apr 25, 1997
3SORT1 ; BUILD UTILITY ARRAY ;Called by NURSEPCP
4 W:$E(IOST)="C"&($R(5000)) "." S DATA=+$G(^NURSF(210,DA,0))
5 Q:$D(^NURSF(210,"AC","R",DA))!(NURSZAP>7&(NURSZDA'=DA)) S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT Q:'NURSZORT
6 S NURNEN=1 D SETFAC^NURAAGS1,SETPROG^NURAAGS1
7 S PLOC="" F S PLOC=$O(^PRSE(452,"G","C",PLOC)) Q:PLOC="" F DA(2)=0:0 S DA(2)=$O(^PRSE(452,"G","C",PLOC,+DATA,DA(2))) Q:DA(2)'>0 I $G(^PRSE(452,DA(2),0))'="",(+NLOC>0!(PLOC=$G(NLOC1))) D
8 . S DATA=$G(^PRSE(452,DA(2),0)),NEP=$S($P(DATA,U,2)'="":$P(DATA,U,2),1:" BLANK"),NDP=+$P(DATA,U,3)
9 . S N1=$P($G(^VA(200,+DATA,0)),U) I N1="" S N1=" BLANK"
10 . I 'NPGM,NEP'=NPGM1 Q
11 . I 'NSP(1),NDP<YRST!(NDP>YREND) Q
12 . I NURMDSW,'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
13 . I NURPLSW,'$G(NURPROG),$G(NURPROG(1))'=$G(NURPROG(2)) Q
14 . S:NURPROG(2)="NURSING" NURPROG(2)=" "_NURPROG(2)
15 . S NCLASS=$P(DATA,U,3)_"-"_$S($P(DATA,U,14)'="":$P(DATA,U,14),1:"")
16 . I NCLASS'="" D
17 . . S:$G(NURSORT)="" NURSORT=1
18 . . N X S X=$G(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),PLOC))
19 . . I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),PLOC)=X,^TMP("NURDATA",$J,"L",NURFAC(2),NURPROG(2),PLOC)=X
20 . . S ^TMP("NURE",$J,"L1",X,$E(NEP,1,30),NCLASS,N1,DA(2))="",^TMP("NURDATA",$J,"L1",X,$E(NEP,1,30),NCLASS)=$P(DATA,U,14)_"^"_$S($D(^PRSE(452,DA(2),6)):$P(^(6),U,2),1:"")_"^"_$P(DATA,U,16)_"^"_$P(DATA,U,6)_"^"_$P(DATA,U,10)
21 . . Q
22 . Q
23 Q
24NPRINT ; PRINT REPORT
25 K NCLASS S (NCLASS("L"),NCLASS("N"))=0
26 S NURFAC(2)="" F S NURFAC(2)=$O(^TMP("NURE",$J,"L",NURFAC(2))) Q:NURFAC(2)="" D NM Q:NUROUT
27 Q
28NM S NURPROG(2)="" F S NURPROG(2)=$O(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2))) Q:NURPROG(2)="" D NN Q:NUROUT
29 Q
30NN S PLOC="" F S PLOC=$O(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),PLOC)) Q:PLOC=""!NUROUT S NURSORT=$G(^(PLOC)) D:$G(NURSORT) NO Q:NUROUT S HOLD=1 D BRK1^NURSEPCP Q:NUROUT
31 Q
32NO W !,$S(PLOC="L":"LOCAL",1:"NON-LOCAL")_" C.E. TRAINING:",! S NEP="" F S NEP=$O(^TMP("NURE",$J,"L1",NURSORT,NEP)) Q:NEP=""!NUROUT D NP Q:NUROUT S HOLD1=1 D BRK^NURSEPCP Q:NUROUT
33 Q
34NP I $Y>(IOSL-8) D NHDR^NURSEPCP Q:NUROUT W !,$S(PLOC="L":"LOCAL",1:"NON-LOCAL")
35 W ?11,$S(NEP'=" BLANK":NEP,1:" "),! S (NCOUNT(1),NCOUNT(2),NDT)=0,NCLASS(PLOC)=NCLASS(PLOC)+1 K NURNAME F S NDT=$O(^TMP("NURE",$J,"L1",NURSORT,NEP,NDT)) Q:NDT'>0!NUROUT S NCOUNT(1)=NCOUNT(1)+1 D NDT Q:NUROUT
36 Q
37NDT IF $Y>(IOSL-8) D NHDR^NURSEPCP Q:NUROUT W !,$S(PLOC="L":"LOCAL",1:"NON-LOCAL"),?11,NEP,!
38 S NDATA=^TMP("NURDATA",$J,"L1",NURSORT,NEP,NDT) W ?15,"Presenter: "_$S($P(NDATA,"^",2)'="":$P(NDATA,"^",2),1:""),?57,$E(NDT,4,5)_"/"_$E(NDT,6,7)_"/"_$E(NDT,2,3)
39 W:$P(NDATA,"^")'="" ?65,"-"_$E($P(NDATA,"^"),4,5)_"/"_$E($P(NDATA,"^"),6,7)_"/"_$E($P(NDATA,"^"),2,3)
40 W ?76,$J(+$P(NDATA,U,3),0,2),?85,$J(+$P(NDATA,U,4),0,1),?92,$J(+$P(NDATA,U,5),0,2)
41 S N1="" F S N1=$O(^TMP("NURE",$J,"L1",NURSORT,NEP,NDT,N1)) Q:N1=""!NUROUT D NR
42 Q
43NR I '$D(NURNAME(N1)) S NCOUNT(2)=NCOUNT(2)+1 S NURNAME(N1)=""
44 F DA(2)=0:0 S DA(2)=$O(^TMP("NURE",$J,"L1",NURSORT,NEP,NDT,N1,DA(2))) Q:DA(2)'>0!NUROUT D NPPRINT Q:NUROUT
45 Q
46NPPRINT ;
47 W:N1'=" BLANK" ?100,$E(N1,1,30),!
48 S (HOLD,HOLD1)=0
49 Q
50SORT ;SORT C.E. DATA
51 Q:NDA'>0!(NURSZAP>7&(NURSZDA'=DA)) S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP Q:'NURSZORT
52 W:$E(IOST)="C"&($R(5000)) "." I $D(^VA(200,NDA,0)),$P(^(0),"^",1)'="" S N1=$P(^(0),"^",1)
53 E S N1=" BLANK"
54 S NURNEN=1 D SETFAC^NURAAGS1,SETPROG^NURAAGS1
55 S NURJ="" F S NURJ=$O(^PRSE(452,"AA","C",NDA,NURJ)) Q:NURJ="" F NDP=0:0 S NDP=$O(^PRSE(452,"AA","C",NDA,NURJ,NDP)) Q:NDP'>0 F NURI=0:0 S NURI=$O(^PRSE(452,"AA","C",NDA,NURJ,NDP,NURI)) Q:NURI'>0 D
56 . S NDP(1)=$P((9999999-NDP),U) I NDP(1)<YRST!(NDP(1)>YREND) Q
57 . I NURMDSW,'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
58 . I NURPLSW,'$G(NURPROG),$G(NURPROG(1))'=$G(NURPROG(2)) Q
59 . S:NURPROG(2)="NURSING" NURPROG(2)=" "_NURPROG(2)
60 . I 'NSP,N1'=NSPC Q
61 . S ^TMP("NURE",$J,NURFAC(2),NURPROG(2),$E(NDP(1),1,30),N1,NURI,DA)=""
62 . Q
63 Q
Note: See TracBrowser for help on using the repository browser.