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 Apr 09, 2024@21:22:28 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
