NURSEPIN ;HIRMFO/MD-INDIVIDUAL INSERVICE RECORD PRINT ;1/5/89 16:10
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ;
S X=$G(^PRSE(452.7,1,"OFF")) Q:X=""!(X=1)
S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
S (NUROUT,NURQUEUE,NUROUT)=0
D INS^NURSAGP2 G QUIT:NUROUT
D DATSEL^NURSAGP2 G QUIT:NUROUT
D EN1^NURSAUTL G QUIT:NUROUT D EN10^NURSUT3($G(DUZ)) I NURSZAP>7 S N2=DUZ G A
S DIC("S")="I +$$EN6^NURSUT3($G(Y))"
D EN3^NURSAGP1 G:NUROUT!'(+Y>0) QUIT S N2=$P($G(Y),U,2)
A W ! S ZTRTN="START^NURSEPIN" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
START ;
K NN S NN=$O(^NURSF(210,"B",N2,0)),NSTATUS="",DA=NN D EN2^NURSUT0 S NSTATUS=$S(NPSPOS(1)="R":"RN",NPSPOS(1)="L":"LPN",NPSPOS(1)="N":"NA",NPSPOS(1)="C":"CK",NPSPOS(1)="S":"SE",NPSPOS(1)="A":"AO",NPSPOS(1)="O":"OT",1:"") S X="T" D ^%DT S NTODAY=Y
K ^TMP("NURE",$J),NN S NURS132=$S(IOM'<132:1,1:0),(NSW2,NURSW1,NUROUT,NURPAGE,TLEN,TLCEU,TLCONT)=0 D SORT U IO
I $O(^TMP("NURE",$J,""))="" D HEADER W !!,"THERE IS NO DATA FOR THIS PERSON!" S NUROUT=1 G QUIT
S N1="" F S N1=$O(^TMP("NURE",$J,N1)) Q:N1=""!NUROUT S NDATE=0 F S NDATE=$O(^TMP("NURE",$J,N1,NDATE)) Q:NDATE'>0 S NS2=0 F S NS2=$O(^TMP("NURE",$J,N1,NDATE,NS2)) Q:NS2'>0!NUROUT D
. I 'NURSW1!($Y>(IOSL-6)) D HEADER Q:NUROUT
. S DATA=$G(^TMP("NURE",$J,N1,NDATE,NS2))
. S NSW2=1 W !,$S(NURS132:N1,1:$E(N1,1,25)),?$S(NURS132:55,1:27),$E($P(DATA,U,4),1,20) W ?$S(NURS132:85,1:50),$E(NDATE,4,5)_"/"_$E(NDATE,6,7)_"/"_$E(NDATE,2,3)
. S Y=+$P(DATA,U,3) W:Y ?$S(NURS132:93,1:59),"-"_$E(+Y,4,5)_"/"_$E(+Y,6,7)_"/"_$E(+Y,2,3) W ?$S(NURS132:107,1:73),$J($P(DATA,U,2),2,2)
. W ! I $P($G(DATA),U,8)'="" W $S(NURS132:$P(DATA,U,8),1:$E($P(DATA,U,8),1,25))
. I $O(^TMP("NURE","REASON",$J,NS2,0)) S PDA=0 F S PDA=$O(^TMP("NURE","REASON",$J,NS2,PDA)) Q:PDA'>0 S X=+$G(^TMP("NURE","REASON",$J,NS2,PDA)) I $P($G(^PRSE(452.6,X,0)),U)'="" W ?$S(NURS132:55,1:27),$P(^(0),U),!
. S TLEN=TLEN+$P(DATA,U,2) I $P(DATA,U,7)="C" W !," CEUs: ",$J(+$P(DATA,U,5),2,2)_" Contact Hrs: ",$J(+$P(DATA,U,6),2,2) S TLCEU=TLCEU+$P(DATA,U,5),TLCONT=TLCONT+$P(DATA,U,6)
. W ! Q
I 'NUROUT W !! W:NURSEL="C"!(NURSEL="A") "Total CEUs = "_$J(TLCEU,0,2)_" Total Contact Hrs = "_$J(TLCONT,0,2)_" " W "Total Class Hrs = "_$J(TLEN,0,2)
QUIT K ^TMP("NURE",$J) D CLOSE^NURSUT1,^NURSKILL
K NTODAY,NSTATUS Q
S NURPAGE=NURPAGE+1,NURSW1=1,NSW2=0 W:'(NURPAGE=1&($E(IOST)'="C")) @IOF
W !,"INDIVIDUAL "_$S(NURSEL="M":"M.I.",NURSEL="C":"C.E",NURSEL="W":"UNIT",NURSEL="O":"OTHER",1:"COMPLETE")_" TRAINING REPORT FOR "_$S(TYP="C":"CY ",TYP="F":"FY ",1:" ")
W $S(TYP="C"!(TYP="F"):$G(Y(0)),1:$G(YRST(1))_" - "_$G(YREND(1)))
W ?$S(NURS132:101,1:62),$E(NTODAY,4,5)_"/"_$E(NTODAY,6,7)_"/"_$E(NTODAY,2,3),?$S(NURS132:121,1:71),"PAGE: ",NURPAGE,!," "
W !,"CLASS",?$S(NURS132:55,1:27),"CLASS LOCATION",?$S(NURS132:85,1:50),"DATE(S)",?$S(NURS132:107,1:73),"CLASS HOURS"
W !,"PRESENTER",?$S(NURS132:55,1:27),"SVC REASON"
W !,$$REPEAT^XLFSTR("-",$S(NURS132:132,1:80)),!,"Employee Name: "_NAM_" "_NSTATUS,!
Q
SORT ;
Q:$P($G(^VA(200,N2,0)),U)="" W:$E(IOST)="C"&($R(500)) "."
S NAM=$P($G(^VA(200,N2,0)),U)
S NURSE="" F S NURSE=$O(^PRSE(452,"AA",NURSE)) Q:NURSE="" F CLS="" F S CLS=$O(^PRSE(452,"AA",NURSE,N2,CLS)) Q:CLS="" D
.I NURSEL'="A"&(NURSEL'=NURSE) Q
.S DAT=0 F S DAT=$O(^PRSE(452,"AA",NURSE,N2,CLS,DAT)) Q:DAT'>0 S DA(2)=0 F S DA(2)=$O(^PRSE(452,"AA",NURSE,N2,CLS,DAT,DA(2))) Q:DA(2)'>0 D
..Q:'$D(^PRSE(452,DA(2),0)) S DATA=$G(^PRSE(452,DA(2),0)),DATA(1)=$P($G(^PRSE(452,DA(2),6)),U,2)
..I $P($G(DATA),U,3)<YRST!($P($G(DATA),U,3)>YREND) Q
..S:$P($G(DATA),U,2)'="" DA(1)=$O(^PRSE(452.1,"B",$P(DATA,U,2),0)) S LEN=+$P($G(^PRSE(452.1,+$G(DA(1)),0)),U,3),X=NAM_U_$S(LEN>0:LEN,1:$P(DATA,U,16))_U_$P(DATA,U,14)_U_$P(DATA,U,15)_U_$P(DATA,U,6)_U_$P(DATA,U,10)_U_$P(DATA,U,21)_U_DATA(1)
..S ^TMP("NURE",$J,$P(DATA,U,2),+$P(DATA,U,3),DA(2))=X
..S PDA=0 F S PDA=$O(^PRSE(452,DA(2),1,PDA)) Q:PDA'>0 I $G(^PRSE(452,DA(2),1,PDA,0))'="" S ^TMP("NURE","REASON",$J,DA(2),PDA)=$G(^PRSE(452,DA(2),1,PDA,0))
..Q
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSEPIN 4112 printed Apr 09, 2024@21:21:23 Page 2
NURSEPIN ;HIRMFO/MD-INDIVIDUAL INSERVICE RECORD PRINT ;1/5/89 16:10
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ;
+1 SET X=$GET(^PRSE(452.7,1,"OFF"))
if X=""!(X=1)
QUIT
+2 SET X=$GET(^DIC(213.9,1,"OFF"))
if X=""!(X=1)
QUIT
+3 SET (NUROUT,NURQUEUE,NUROUT)=0
+4 DO INS^NURSAGP2
if NUROUT
GOTO QUIT
+5 DO DATSEL^NURSAGP2
if NUROUT
GOTO QUIT
+6 DO EN1^NURSAUTL
if NUROUT
GOTO QUIT
DO EN10^NURSUT3($GET(DUZ))
IF NURSZAP>7
SET N2=DUZ
GOTO A
+7 SET DIC("S")="I +$$EN6^NURSUT3($G(Y))"
+8 DO EN3^NURSAGP1
if NUROUT!'(+Y>0)
GOTO QUIT
SET N2=$PIECE($GET(Y),U,2)
A WRITE !
SET ZTRTN="START^NURSEPIN"
DO EN7^NURSUT0
if POP!($DATA(ZTSK))
GOTO QUIT
START ;
+1 KILL NN
SET NN=$ORDER(^NURSF(210,"B",N2,0))
SET NSTATUS=""
SET DA=NN
DO EN2^NURSUT0
SET NSTATUS=$SELECT(NPSPOS(1)="R":"RN",NPSPOS(1)="L":"LPN",NPSPOS(1)="N":"NA",NPSPOS(1)="C":"CK",NPSPOS(1)="S":"SE",NPSPOS(1)="A":"AO",NPSPOS(1)="O":"OT",1:"")
SET X="T"
DO ^%DT
SET NTODAY=Y
+2 KILL ^TMP("NURE",$JOB),NN
SET NURS132=$SELECT(IOM'<132:1,1:0)
SET (NSW2,NURSW1,NUROUT,NURPAGE,TLEN,TLCEU,TLCONT)=0
DO SORT
USE IO
+3 IF $ORDER(^TMP("NURE",$JOB,""))=""
DO HEADER
WRITE !!,"THERE IS NO DATA FOR THIS PERSON!"
SET NUROUT=1
GOTO QUIT
+4 SET N1=""
FOR
SET N1=$ORDER(^TMP("NURE",$JOB,N1))
if N1=""!NUROUT
QUIT
SET NDATE=0
FOR
SET NDATE=$ORDER(^TMP("NURE",$JOB,N1,NDATE))
if NDATE'>0
QUIT
SET NS2=0
FOR
SET NS2=$ORDER(^TMP("NURE",$JOB,N1,NDATE,NS2))
if NS2'>0!NUROUT
QUIT
Begin DoDot:1
+5 IF 'NURSW1!($Y>(IOSL-6))
DO HEADER
if NUROUT
QUIT
+6 SET DATA=$GET(^TMP("NURE",$JOB,N1,NDATE,NS2))
+7 SET NSW2=1
WRITE !,$SELECT(NURS132:N1,1:$EXTRACT(N1,1,25)),?$SELECT(NURS132:55,1:27),$EXTRACT($PIECE(DATA,U,4),1,20)
WRITE ?$SELECT(NURS132:85,1:50),$EXTRACT(NDATE,4,5)_"/"_$EXTRACT(NDATE,6,7)_"/"_$EXTRACT(NDATE,2,3)
+8 SET Y=+$PIECE(DATA,U,3)
if Y
WRITE ?$SELECT(NURS132:93,1:59),"-"_$EXTRACT(+Y,4,5)_"/"_$EXTRACT(+Y,6,7)_"/"_$EXTRACT(+Y,2,3)
WRITE ?$SELECT(NURS132:107,1:73),$JUSTIFY($PIECE(DATA,U,2),2,2)
+9 WRITE !
IF $PIECE($GET(DATA),U,8)'=""
WRITE $SELECT(NURS132:$PIECE(DATA,U,8),1:$EXTRACT($PIECE(DATA,U,8),1,25))
+10 IF $ORDER(^TMP("NURE","REASON",$JOB,NS2,0))
SET PDA=0
FOR
SET PDA=$ORDER(^TMP("NURE","REASON",$JOB,NS2,PDA))
if PDA'>0
QUIT
SET X=+$GET(^TMP("NURE","REASON",$JOB,NS2,PDA))
IF $PIECE($GET(^PRSE(452.6,X,0)),U)'=""
WRITE ?$SELECT(NURS132:55,1:27),$PIECE(^(0),U),!
+11 SET TLEN=TLEN+$PIECE(DATA,U,2)
IF $PIECE(DATA,U,7)="C"
WRITE !," CEUs: ",$JUSTIFY(+$PIECE(DATA,U,5),2,2)_" Contact Hrs: ",$JUSTIFY(+$PIECE(DATA,U,6),2,2)
SET TLCEU=TLCEU+$PIECE(DATA,U,5)
SET TLCONT=TLCONT+$PIECE(DATA,U,6)
+12 WRITE !
QUIT
End DoDot:1
+13 IF 'NUROUT
WRITE !!
if NURSEL="C"!(NURSEL="A")
WRITE "Total CEUs = "_$JUSTIFY(TLCEU,0,2)_" Total Contact Hrs = "_$JUSTIFY(TLCONT,0,2)_" "
WRITE "Total Class Hrs = "_$JUSTIFY(TLEN,0,2)
QUIT KILL ^TMP("NURE",$JOB)
DO CLOSE^NURSUT1
DO ^NURSKILL
+1 KILL NTODAY,NSTATUS
QUIT
IF $EXTRACT(IOST)="C"
IF NURSW1
DO ENDPG^NURSUT1
if NUROUT
QUIT
+1 SET NURPAGE=NURPAGE+1
SET NURSW1=1
SET NSW2=0
if '(NURPAGE=1&($EXTRACT(IOST)'="C"))
WRITE @IOF
+2 WRITE !,"INDIVIDUAL "_$SELECT(NURSEL="M":"M.I.",NURSEL="C":"C.E",NURSEL="W":"UNIT",NURSEL="O":"OTHER",1:"COMPLETE")_" TRAINING REPORT FOR "_$SELECT(TYP="C":"CY ",TYP="F":"FY ",1:" ")
+3 WRITE $SELECT(TYP="C"!(TYP="F"):$GET(Y(0)),1:$GET(YRST(1))_" - "_$GET(YREND(1)))
+4 WRITE ?$SELECT(NURS132:101,1:62),$EXTRACT(NTODAY,4,5)_"/"_$EXTRACT(NTODAY,6,7)_"/"_$EXTRACT(NTODAY,2,3),?$SELECT(NURS132:121,1:71),"PAGE: ",NURPAGE,!," "
+5 WRITE !,"CLASS",?$SELECT(NURS132:55,1:27),"CLASS LOCATION",?$SELECT(NURS132:85,1:50),"DATE(S)",?$SELECT(NURS132:107,1:73),"CLASS HOURS"
+6 WRITE !,"PRESENTER",?$SELECT(NURS132:55,1:27),"SVC REASON"
+7 WRITE !,$$REPEAT^XLFSTR("-",$SELECT(NURS132:132,1:80)),!,"Employee Name: "_NAM_" "_NSTATUS,!
+8 QUIT
SORT ;
+1 if $PIECE($GET(^VA(200,N2,0)),U)=""
QUIT
if $EXTRACT(IOST)="C"&($RANDOM(500))
WRITE "."
+2 SET NAM=$PIECE($GET(^VA(200,N2,0)),U)
+3 SET NURSE=""
FOR
SET NURSE=$ORDER(^PRSE(452,"AA",NURSE))
if NURSE=""
QUIT
FOR CLS=""
FOR
SET CLS=$ORDER(^PRSE(452,"AA",NURSE,N2,CLS))
if CLS=""
QUIT
Begin DoDot:1
+4 IF NURSEL'="A"&(NURSEL'=NURSE)
QUIT
+5 SET DAT=0
FOR
SET DAT=$ORDER(^PRSE(452,"AA",NURSE,N2,CLS,DAT))
if DAT'>0
QUIT
SET DA(2)=0
FOR
SET DA(2)=$ORDER(^PRSE(452,"AA",NURSE,N2,CLS,DAT,DA(2)))
if DA(2)'>0
QUIT
Begin DoDot:2
+6 if '$DATA(^PRSE(452,DA(2),0))
QUIT
SET DATA=$GET(^PRSE(452,DA(2),0))
SET DATA(1)=$PIECE($GET(^PRSE(452,DA(2),6)),U,2)
+7 IF $PIECE($GET(DATA),U,3)<YRST!($PIECE($GET(DATA),U,3)>YREND)
QUIT
+8 if $PIECE($GET(DATA),U,2)'=""
SET DA(1)=$ORDER(^PRSE(452.1,"B",$PIECE(DATA,U,2),0))
SET LEN=+$PIECE($GET(^PRSE(452.1,+$GET(DA(1)),0)),U,3)
SET X=NAM_U_$SELECT(LEN>0:LEN,1:$PIECE(DATA,U,16))_U_$PIECE(DATA,U,14)_U_$PIECE(DATA,U,15)_U_$PIECE(DATA,U,6)_U_$PIECE(DATA,U,10)_U_$PIECE(DATA,U,21)_U_DATA(1)
+9 SET ^TMP("NURE",$JOB,$PIECE(DATA,U,2),+$PIECE(DATA,U,3),DA(2))=X
+10 SET PDA=0
FOR
SET PDA=$ORDER(^PRSE(452,DA(2),1,PDA))
if PDA'>0
QUIT
IF $GET(^PRSE(452,DA(2),1,PDA,0))'=""
SET ^TMP("NURE","REASON",$JOB,DA(2),PDA)=$GET(^PRSE(452,DA(2),1,PDA,0))
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 QUIT
