- NURA6K1 ;HIRMFO/RM,JH,MD,FT-INDIVIDUAL PROFICIENCY REPORT ;8/8/96 13:14
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- S (NURQUIT,NURQUEUE,NUROUT)=0
- D EN1^NURSAUTL G QUIT:NUROUT
- S DIC("S")="I +$$EN6^NURSUT3($G(Y)) S DA=+Y D EN2^NURSUT0 I NPSPOS(1)=""R"""
- ;S DIC("S")=DIC("S")_" S DA=+Y I NURSZORT D EN2^NURSUT0 I $S(NPSPOS(0)="""":0,'$D(^NURSF(211.3,NPSPOS(0),0)):0,$P(^(0),U,5)=""R"":1,1:0)"
- D EN3^NURSAGP1 G QUIT:NUROUT
- W ! S ZTDESC="Individual Proficiency Report",ZTRTN="START^NURA6K1",NURS132=1 D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- U IO S (NURPAGE,NUROUT,NURSW1,NURQUIT)=0 D HEADER,PRINT
- QUIT K ^TMP($J) D CLOSE^NURSUT1,^NURAKILL
- Q
- ; DETAIL LINE PRINT ROUTINE
- PRINT I $D(^NURSF(210,N1,0))&($D(^NURSF(210,N1,14))) D WRITE Q
- E W !?5," NO RECORD FOUND FOR THIS EMPLOYEE " Q
- Q
- WRITE ;
- S NURSW1=1 W:N2'="" !,$E($P(^VA(200,N2,0),"^",1),1,20)
- I N2'="",$D(^VA(200,N2,1)) S M=$S($P(^(1),"^",9)'="":$P(^(1),"^",9),1:"") W:M'="" ?23,$E(M,1,3),"-",$E(M,4,5),"-",$E(M,6,9)
- S DA=N1 S NOD1=$P($G(^NURSF(211.8,NOD1,0)),U),NPWARD=$S(+NOD1:$O(^NURSF(211.4,"B",NOD1,0)),1:" BLANK") D WRITE1 Q:NURQUIT
- Q
- WRITE1 Q:NURQUIT D EN6^NURSAUTL S NL1=$E(NPWARD,1,10) W ?40,NL1
- F NN=0:0 S NN=$O(^NURSF(210,N1,14,NN)) Q:NN'>0 I $D(^NURSF(210,N1,14,0)) D NGO Q:NURQUIT
- Q
- NGO I ($Y>(IOSL-6)) D HEADER Q:NURQUIT
- I $D(^NURSF(210,N1,14,NN,0)) S:$P(^(0),"^")'="" (Y,NDD)=$P(^(0),"^") D:+Y D^DIQ W:$D(Y) ?51,Y
- I S NIE=$S($P(^NURSF(210,N1,14,NN,0),"^",2)'="":$P(^VA(200,$P(^(0),"^",2),0),"^"),1:"") W:$D(NIE) ?65,NIE
- S DATA=$G(^NURSF(210,N1,14,NN,0)) F I=4,5 I +$P(DATA,U,I) S Y=$P(DATA,U,I) D D^DIQ S ZZ=$S(I=4:91,1:105) W ?ZZ,Y
- W ! Q
- S NURPAGE=NURPAGE+1 W:$E(IOST)="C"!(NURPAGE>1) @IOF
- W !,"INDIVIDUAL PROFICIENCY PROFILE" S X="T" D ^%DT D:+Y D^DIQ W ?90,Y,?105,"PAGE: ",NURPAGE
- W !!,?51,"DATE",?91,"WORK COPY",?105,"COPY RET'D",!,"NAME",?23,"SSN",?40,"LOCATION",?51,"DUE",?65,"EVALUATOR",?91,"SENT OUT",?105,"FOR TYPING"
- W !,$$REPEAT^XLFSTR("-",132),!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURA6K1 2140 printed Mar 13, 2025@21:23:27 Page 2
- NURA6K1 ;HIRMFO/RM,JH,MD,FT-INDIVIDUAL PROFICIENCY REPORT ;8/8/96 13:14
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- +2 if '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- QUIT
- +3 SET (NURQUIT,NURQUEUE,NUROUT)=0
- +4 DO EN1^NURSAUTL
- if NUROUT
- GOTO QUIT
- +5 SET DIC("S")="I +$$EN6^NURSUT3($G(Y)) S DA=+Y D EN2^NURSUT0 I NPSPOS(1)=""R"""
- +6 ;S DIC("S")=DIC("S")_" S DA=+Y I NURSZORT D EN2^NURSUT0 I $S(NPSPOS(0)="""":0,'$D(^NURSF(211.3,NPSPOS(0),0)):0,$P(^(0),U,5)=""R"":1,1:0)"
- +7 DO EN3^NURSAGP1
- if NUROUT
- GOTO QUIT
- +8 WRITE !
- SET ZTDESC="Individual Proficiency Report"
- SET ZTRTN="START^NURA6K1"
- SET NURS132=1
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 USE IO
- SET (NURPAGE,NUROUT,NURSW1,NURQUIT)=0
- DO HEADER
- DO PRINT
- QUIT KILL ^TMP($JOB)
- DO CLOSE^NURSUT1
- DO ^NURAKILL
- +1 QUIT
- +2 ; DETAIL LINE PRINT ROUTINE
- PRINT IF $DATA(^NURSF(210,N1,0))&($DATA(^NURSF(210,N1,14)))
- DO WRITE
- QUIT
- +1 IF '$TEST
- WRITE !?5," NO RECORD FOUND FOR THIS EMPLOYEE "
- QUIT
- +2 QUIT
- WRITE ;
- +1 SET NURSW1=1
- if N2'=""
- WRITE !,$EXTRACT($PIECE(^VA(200,N2,0),"^",1),1,20)
- +2 IF N2'=""
- IF $DATA(^VA(200,N2,1))
- SET M=$SELECT($PIECE(^(1),"^",9)'="":$PIECE(^(1),"^",9),1:"")
- if M'=""
- WRITE ?23,$EXTRACT(M,1,3),"-",$EXTRACT(M,4,5),"-",$EXTRACT(M,6,9)
- +3 SET DA=N1
- SET NOD1=$PIECE($GET(^NURSF(211.8,NOD1,0)),U)
- SET NPWARD=$SELECT(+NOD1:$ORDER(^NURSF(211.4,"B",NOD1,0)),1:" BLANK")
- DO WRITE1
- if NURQUIT
- QUIT
- +4 QUIT
- WRITE1 if NURQUIT
- QUIT
- DO EN6^NURSAUTL
- SET NL1=$EXTRACT(NPWARD,1,10)
- WRITE ?40,NL1
- +1 FOR NN=0:0
- SET NN=$ORDER(^NURSF(210,N1,14,NN))
- if NN'>0
- QUIT
- IF $DATA(^NURSF(210,N1,14,0))
- DO NGO
- if NURQUIT
- QUIT
- +2 QUIT
- NGO IF ($Y>(IOSL-6))
- DO HEADER
- if NURQUIT
- QUIT
- +1 IF $DATA(^NURSF(210,N1,14,NN,0))
- if $PIECE(^(0),"^")'=""
- SET (Y,NDD)=$PIECE(^(0),"^")
- if +Y
- DO D^DIQ
- if $DATA(Y)
- WRITE ?51,Y
- +2 IF $TEST
- SET NIE=$SELECT($PIECE(^NURSF(210,N1,14,NN,0),"^",2)'="":$PIECE(^VA(200,$PIECE(^(0),"^",2),0),"^"),1:"")
- if $DATA(NIE)
- WRITE ?65,NIE
- +3 SET DATA=$GET(^NURSF(210,N1,14,NN,0))
- FOR I=4,5
- IF +$PIECE(DATA,U,I)
- SET Y=$PIECE(DATA,U,I)
- DO D^DIQ
- SET ZZ=$SELECT(I=4:91,1:105)
- WRITE ?ZZ,Y
- +4 WRITE !
- QUIT
- IF $EXTRACT(IOST)="C"
- IF NURSW1
- DO ENDPG^NURSUT1
- if NUROUT
- SET NURQUIT=+NUROUT
- if NURQUIT
- QUIT
- +1 SET NURPAGE=NURPAGE+1
- if $EXTRACT(IOST)="C"!(NURPAGE>1)
- WRITE @IOF
- +2 WRITE !,"INDIVIDUAL PROFICIENCY PROFILE"
- SET X="T"
- DO ^%DT
- if +Y
- DO D^DIQ
- WRITE ?90,Y,?105,"PAGE: ",NURPAGE
- +3 WRITE !!,?51,"DATE",?91,"WORK COPY",?105,"COPY RET'D",!,"NAME",?23,"SSN",?40,"LOCATION",?51,"DUE",?65,"EVALUATOR",?91,"SENT OUT",?105,"FOR TYPING"
- +4 WRITE !,$$REPEAT^XLFSTR("-",132),!
- +5 QUIT
