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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSEPC0 4161 printed Apr 09, 2024@21:22:17 Page 2
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
