- 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 Mar 13, 2025@21:27:11 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
