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

NURSEPC0 ;HIRMFO/PC,FT-C.E.PROGRAM ATTENDANCE SUMMARY,PRINT CON'T ;5/9/97
 ;;4.0;NURSING SERVICE;**1**;Apr 25, 1997
SORT1 ; BUILD UTILITY ARRAY ;Called by NURSEPCP
 W:$E(IOST)="C"&($R(5000)) "." S DATA=+$G(^NURSF(210,DA,0))
 Q:$D(^NURSF(210,"AC","R",DA))!(NURSZAP>7&(NURSZDA'=DA))  S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT Q:'NURSZORT
 S NURNEN=1 D SETFAC^NURAAGS1,SETPROG^NURAAGS1
 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
 .  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)
 .  S N1=$P($G(^VA(200,+DATA,0)),U) I N1="" S N1="  BLANK"
 .  I 'NPGM,NEP'=NPGM1 Q
 .  I 'NSP(1),NDP<YRST!(NDP>YREND) 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)
 .  S NCLASS=$P(DATA,U,3)_"-"_$S($P(DATA,U,14)'="":$P(DATA,U,14),1:"")
 .  I NCLASS'="" D
 .  .  S:$G(NURSORT)="" NURSORT=1
 .  .  N X S X=$G(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),PLOC))
 .  .  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
 .  .  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)
 .  .  Q
 .  Q
 Q
NPRINT ; PRINT REPORT
 K NCLASS S (NCLASS("L"),NCLASS("N"))=0
 S NURFAC(2)="" F  S NURFAC(2)=$O(^TMP("NURE",$J,"L",NURFAC(2))) Q:NURFAC(2)=""  D NM Q:NUROUT
 Q
NM S NURPROG(2)="" F  S NURPROG(2)=$O(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2))) Q:NURPROG(2)=""  D NN Q:NUROUT
 Q
NN 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
 Q
NO 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
 Q
NP I $Y>(IOSL-8) D NHDR^NURSEPCP Q:NUROUT  W !,$S(PLOC="L":"LOCAL",1:"NON-LOCAL")
 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
 Q
NDT IF $Y>(IOSL-8) D NHDR^NURSEPCP Q:NUROUT  W !,$S(PLOC="L":"LOCAL",1:"NON-LOCAL"),?11,NEP,!
 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)
 W:$P(NDATA,"^")'="" ?65,"-"_$E($P(NDATA,"^"),4,5)_"/"_$E($P(NDATA,"^"),6,7)_"/"_$E($P(NDATA,"^"),2,3)
 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)
 S N1="" F  S N1=$O(^TMP("NURE",$J,"L1",NURSORT,NEP,NDT,N1)) Q:N1=""!NUROUT  D NR
 Q
NR I '$D(NURNAME(N1)) S NCOUNT(2)=NCOUNT(2)+1 S NURNAME(N1)=""
 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
 Q
NPPRINT ;
 W:N1'="  BLANK" ?100,$E(N1,1,30),!
 S (HOLD,HOLD1)=0
 Q
SORT ;SORT C.E. DATA
 Q:NDA'>0!(NURSZAP>7&(NURSZDA'=DA))  S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP Q:'NURSZORT
 W:$E(IOST)="C"&($R(5000)) "." I $D(^VA(200,NDA,0)),$P(^(0),"^",1)'="" S N1=$P(^(0),"^",1)
 E  S N1="  BLANK"
 S NURNEN=1 D SETFAC^NURAAGS1,SETPROG^NURAAGS1
 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
 .  S NDP(1)=$P((9999999-NDP),U) I NDP(1)<YRST!(NDP(1)>YREND) 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)
 .  I 'NSP,N1'=NSPC Q
 .  S ^TMP("NURE",$J,NURFAC(2),NURPROG(2),$E(NDP(1),1,30),N1,NURI,DA)=""
 .  Q
 Q