- 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
- NURSEPC0 ;HIRMFO/PC,FT-C.E.PROGRAM ATTENDANCE SUMMARY,PRINT CON'T ;5/9/97
- +1 ;;4.0;NURSING SERVICE;**1**;Apr 25, 1997
- SORT1 ; BUILD UTILITY ARRAY ;Called by NURSEPCP
- +1 IF $EXTRACT(IOST)="C"&($RANDOM(5000))
- WRITE "."
- SET DATA=+$GET(^NURSF(210,DA,0))
- +2 IF $DATA(^NURSF(210,"AC","R",DA))!(NURSZAP>7&(NURSZDA'=DA))
- QUIT
- SET NURSZORT=1
- IF NURSZAP>6
- DO EN3^NURSAUTL
- IF NURSZORT
- DO EN2^NURSAUTL
- IF 'NURSZORT
- QUIT
- +3 SET NURNEN=1
- DO SETFAC^NURAAGS1
- DO SETPROG^NURAAGS1
- +4 SET PLOC=""
- FOR
- SET PLOC=$ORDER(^PRSE(452,"G","C",PLOC))
- IF PLOC=""
- QUIT
- FOR DA(2)=0:0
- SET DA(2)=$ORDER(^PRSE(452,"G","C",PLOC,+DATA,DA(2)))
- IF DA(2)'>0
- QUIT
- IF $GET(^PRSE(452,DA(2),0))'=""
- IF (+NLOC>0!(PLOC=$GET(NLOC1)))
- Begin DoDot:1
- +5 SET DATA=$GET(^PRSE(452,DA(2),0))
- SET NEP=$SELECT($PIECE(DATA,U,2)'="":$PIECE(DATA,U,2),1:" BLANK")
- SET NDP=+$PIECE(DATA,U,3)
- +6 SET N1=$PIECE($GET(^VA(200,+DATA,0)),U)
- IF N1=""
- SET N1=" BLANK"
- +7 IF 'NPGM
- IF NEP'=NPGM1
- QUIT
- +8 IF 'NSP(1)
- IF NDP<YRST!(NDP>YREND)
- QUIT
- +9 IF NURMDSW
- IF '$GET(NURFAC)
- IF $GET(NURFAC(1))'=$GET(NURFAC(2))
- QUIT
- +10 IF NURPLSW
- IF '$GET(NURPROG)
- IF $GET(NURPROG(1))'=$GET(NURPROG(2))
- QUIT
- +11 IF NURPROG(2)="NURSING"
- SET NURPROG(2)=" "_NURPROG(2)
- +12 SET NCLASS=$PIECE(DATA,U,3)_"-"_$SELECT($PIECE(DATA,U,14)'="":$PIECE(DATA,U,14),1:"")
- +13 IF NCLASS'=""
- Begin DoDot:2
- +14 IF $GET(NURSORT)=""
- SET NURSORT=1
- +15 NEW X
- SET X=$GET(^TMP("NURE",$JOB,"L",NURFAC(2),NURPROG(2),PLOC))
- +16 IF X=""
- SET X=NURSORT
- SET NURSORT=NURSORT+1
- SET ^TMP("NURE",$JOB,"L",NURFAC(2),NURPROG(2),PLOC)=X
- SET ^TMP("NURDATA",$JOB,"L",NURFAC(2),NURPROG(2),PLOC)=X
- +17 SET ^TMP("NURE",$JOB,"L1",X,$EXTRACT(NEP,1,30),NCLASS,N1,DA(2))=""
- SET ^TMP("NURDATA",$JOB,"L1",X,$EXTRACT(NEP,1,30),NCLASS)=$PIECE(DATA,U,14)_"^"_$SELECT($DATA(^PRSE(452,DA(2),6)):$PIECE(^(6),U,2),1:"")_"^"_$PIECE(DATA,U,16)_"^"_$PIECE(DATA,U,6)_"^"_$PIECE(DATA,U,10)
- +18 QUIT
- End DoDot:2
- +19 QUIT
- End DoDot:1
- +20 QUIT
- NPRINT ; PRINT REPORT
- +1 KILL NCLASS
- SET (NCLASS("L"),NCLASS("N"))=0
- +2 SET NURFAC(2)=""
- FOR
- SET NURFAC(2)=$ORDER(^TMP("NURE",$JOB,"L",NURFAC(2)))
- IF NURFAC(2)=""
- QUIT
- DO NM
- IF NUROUT
- QUIT
- +3 QUIT
- NM SET NURPROG(2)=""
- FOR
- SET NURPROG(2)=$ORDER(^TMP("NURE",$JOB,"L",NURFAC(2),NURPROG(2)))
- IF NURPROG(2)=""
- QUIT
- DO NN
- IF NUROUT
- QUIT
- +1 QUIT
- NN SET PLOC=""
- FOR
- SET PLOC=$ORDER(^TMP("NURE",$JOB,"L",NURFAC(2),NURPROG(2),PLOC))
- IF PLOC=""!NUROUT
- QUIT
- SET NURSORT=$GET(^(PLOC))
- IF $GET(NURSORT)
- DO NO
- IF NUROUT
- QUIT
- SET HOLD=1
- DO BRK1^NURSEPCP
- IF NUROUT
- QUIT
- +1 QUIT
- NO WRITE !,$SELECT(PLOC="L":"LOCAL",1:"NON-LOCAL")_" C.E. TRAINING:",!
- SET NEP=""
- FOR
- SET NEP=$ORDER(^TMP("NURE",$JOB,"L1",NURSORT,NEP))
- IF NEP=""!NUROUT
- QUIT
- DO NP
- IF NUROUT
- QUIT
- SET HOLD1=1
- DO BRK^NURSEPCP
- IF NUROUT
- QUIT
- +1 QUIT
- NP IF $Y>(IOSL-8)
- DO NHDR^NURSEPCP
- IF NUROUT
- QUIT
- WRITE !,$SELECT(PLOC="L":"LOCAL",1:"NON-LOCAL")
- +1 WRITE ?11,$SELECT(NEP'=" BLANK":NEP,1:" "),!
- SET (NCOUNT(1),NCOUNT(2),NDT)=0
- SET NCLASS(PLOC)=NCLASS(PLOC)+1
- KILL NURNAME
- FOR
- SET NDT=$ORDER(^TMP("NURE",$JOB,"L1",NURSORT,NEP,NDT))
- IF NDT'>0!NUROUT
- QUIT
- SET NCOUNT(1)=NCOUNT(1)+1
- DO NDT
- IF NUROUT
- QUIT
- +2 QUIT
- NDT IF $Y>(IOSL-8)
- DO NHDR^NURSEPCP
- IF NUROUT
- QUIT
- WRITE !,$SELECT(PLOC="L":"LOCAL",1:"NON-LOCAL"),?11,NEP,!
- +1 SET NDATA=^TMP("NURDATA",$JOB,"L1",NURSORT,NEP,NDT)
- WRITE ?15,"Presenter: "_$SELECT($PIECE(NDATA,"^",2)'="":$PIECE(NDATA,"^",2),1:""),?57,$EXTRACT(NDT,4,5)_"/"_$EXTRACT(NDT,6,7)_"/"_$EXTRACT(NDT,2,3)
- +2 IF $PIECE(NDATA,"^")'=""
- WRITE ?65,"-"_$EXTRACT($PIECE(NDATA,"^"),4,5)_"/"_$EXTRACT($PIECE(NDATA,"^"),6,7)_"/"_$EXTRACT($PIECE(NDATA,"^"),2,3)
- +3 WRITE ?76,$JUSTIFY(+$PIECE(NDATA,U,3),0,2),?85,$JUSTIFY(+$PIECE(NDATA,U,4),0,1),?92,$JUSTIFY(+$PIECE(NDATA,U,5),0,2)
- +4 SET N1=""
- FOR
- SET N1=$ORDER(^TMP("NURE",$JOB,"L1",NURSORT,NEP,NDT,N1))
- IF N1=""!NUROUT
- QUIT
- DO NR
- +5 QUIT
- NR IF '$DATA(NURNAME(N1))
- SET NCOUNT(2)=NCOUNT(2)+1
- SET NURNAME(N1)=""
- +1 FOR DA(2)=0:0
- SET DA(2)=$ORDER(^TMP("NURE",$JOB,"L1",NURSORT,NEP,NDT,N1,DA(2)))
- IF DA(2)'>0!NUROUT
- QUIT
- DO NPPRINT
- IF NUROUT
- QUIT
- +2 QUIT
- NPPRINT ;
- +1 IF N1'=" BLANK"
- WRITE ?100,$EXTRACT(N1,1,30),!
- +2 SET (HOLD,HOLD1)=0
- +3 QUIT
- SORT ;SORT C.E. DATA
- +1 IF NDA'>0!(NURSZAP>7&(NURSZDA'=DA))
- QUIT
- SET NURSZORT=1
- IF NURSZAP>6
- DO EN3^NURSAUTL
- IF NURSZORT&NURSZAP
- DO EN2^NURSAUTL
- IF 'NURSZORT
- QUIT
- +2 IF $EXTRACT(IOST)="C"&($RANDOM(5000))
- WRITE "."
- IF $DATA(^VA(200,NDA,0))
- IF $PIECE(^(0),"^",1)'=""
- SET N1=$PIECE(^(0),"^",1)
- +3 IF '$TEST
- SET N1=" BLANK"
- +4 SET NURNEN=1
- DO SETFAC^NURAAGS1
- DO SETPROG^NURAAGS1
- +5 SET NURJ=""
- FOR
- SET NURJ=$ORDER(^PRSE(452,"AA","C",NDA,NURJ))
- IF NURJ=""
- QUIT
- FOR NDP=0:0
- SET NDP=$ORDER(^PRSE(452,"AA","C",NDA,NURJ,NDP))
- IF NDP'>0
- QUIT
- FOR NURI=0:0
- SET NURI=$ORDER(^PRSE(452,"AA","C",NDA,NURJ,NDP,NURI))
- IF NURI'>0
- QUIT
- Begin DoDot:1
- +6 SET NDP(1)=$PIECE((9999999-NDP),U)
- IF NDP(1)<YRST!(NDP(1)>YREND)
- QUIT
- +7 IF NURMDSW
- IF '$GET(NURFAC)
- IF $GET(NURFAC(1))'=$GET(NURFAC(2))
- QUIT
- +8 IF NURPLSW
- IF '$GET(NURPROG)
- IF $GET(NURPROG(1))'=$GET(NURPROG(2))
- QUIT
- +9 IF NURPROG(2)="NURSING"
- SET NURPROG(2)=" "_NURPROG(2)
- +10 IF 'NSP
- IF N1'=NSPC
- QUIT
- +11 SET ^TMP("NURE",$JOB,NURFAC(2),NURPROG(2),$EXTRACT(NDP(1),1,30),N1,NURI,DA)=""
- +12 QUIT
- End DoDot:1
- +13 QUIT
