NURQRPT1 ;HIRMFO/YH-QI SUMMARY REPORT, PART 2 ;4/22/96
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 D HDR^NURQRPT0 Q:$G(NUROUT) S NURQB="",$P(NURQB," ",40)=""
S NURQTXT="A. DISCIPLINES: "_$S($D(NURQAR)&($D(NURQSRVC)):NURQAR_", "_$$GET1^DIQ(49,+NURQSRVC,.01,"I"),1:""),NURQTXT(1)=$E(NURQB,1,4) D DIWP^NURQRPT3(.NURQTXT)
Q:$G(NUROUT) D DATA Q:$G(NUROUT) D RECEIVR^NURQRPT2 Q:$G(NUROUT) D REFER^NURQRPT3
Q:$G(NUROUT) W !!,?40,"ENTERED BY: " I $D(^VA(200,+NURQND,0)),$P(^(0),"^")'="" W $P(^(0),"^")
W !,"F. LOCATION INFORMATION:" D LOC
Q
LOC ;PRINT DATA FOR EACH UNIT
I $G(NUREQWRD),'$D(^NURQ(217,DA,2,"B",+NUREQWRD)) D:($Y>(IOSL-7)) HDR^NURQRPT0 W !,?3,"No location information entered for "_$S($D(^SC(+NUREQWRD,0)):$P($P($G(^(0)),"^"),"NUR ",2),1:" "),! Q
S (D1,D1(1))=0 F S D1=$O(NUREQWRD(D1)) Q:D1'>0!$G(NUROUT) S NURQWRD=$P(NUREQWRD(D1),"^"),D1(1)=D1(1)+1 D
.D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W !!,?3,"**********",!,?3,D1(1)_". "_$P(NUREQWRD(D1),"^",2)
.W !,?6,"A. SURVEY STATISTCS:"
.S NURDEM=$$SURLOC^NURQUTL1(NURQSVN) D:'NURDEM&($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W:'NURDEM !!,?9,"No statistics data for this unit",! D:NURDEM ^NURQUTL3
.Q:$G(NUROUT) D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W !,?6,"B. IMPORTANT FUNCTIONS:"
.D IMPORTNT Q:$G(NUROUT)
.D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W !!,?6,"C. PERFORMANCE MEASUREMENTS:" D PERFORM^NURQRPT4
.Q
Q
IMPORTNT ;PRINT IMPORTANT FUNCTION
D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W ! D FHEADR^NURQRPT0
Q:$G(NUROUT) I $P($G(^NURQ(217,DA,2,D1,2,0)),"^",4)>0 D
.S NLEVL=0 F D2=0:0 S D2=$O(^NURQ(217,DA,2,D1,2,D2)) Q:D2'>0!$G(NUROUT) K ^UTILITY($J) N X S X=$P($G(^NURQ(217,DA,2,D1,2,D2,0)),"^") S DIWF="",DIWL=0,DIWR=20 D ^DIWP K NFUNC S NFUNC=0 D MERGE^NURQRPT3(.NFUNC,19) S:$G(NLEVL)<NFUNC NLEVL=NFUNC D
..I $P($G(^NURQ(217,DA,2,D1,2,D2,1,0)),"^",3)>0 D CARE
..Q:$G(NUROUT) I $P($G(^NURQ(217,DA,2,D1,2,D2,2,0)),"^",3)>0 D PRACT
..Q:$G(NUROUT) I NLEVL>0 D WRITE^NURQRPT3 Q
..E W !,"No Important Function entered"
K NCARE1,NCARE2,NPRACT1,NPRACT2,ND3,K,NURSERVC,NURSERVP Q
CARE K NURSERVC S ND3=0 F D3=0:0 S D3=$O(^NURQ(217,DA,2,D1,2,D2,1,D3)) Q:D3'>0!$G(NUROUT) N X S NURSERVC=+$P($G(^(D3,0)),"^"),NURSERVC(1)=$$GET1^DIQ(49,+$P($G(^NURQ(217.1,+NURSERVC,1)),"^",2),.01,"I"),X=$G(^NURQ(217.1,+NURSERVC,0)) D
.S DIWF="",DIWL=0,DIWR=18 K ^UTILITY($J) D ^DIWP S NARY="NCARE"_D3,ND3=D3 K @NARY S @NARY=0 D MERGE^NURQRPT3(.@NARY,18)
.N X S X=NURSERVC(1) K NSERCV S NURSERVC=0,DIWF="",DIWL=0,DIWR=9 K ^UTILITY($J) D ^DIWP,MERGE^NURQRPT3(.NURSERVC,9)
.S NI=$S(@NARY>NURSERVC:@NARY,1:NURSERVC)
.F NI(1)=1:1:NI S @(NARY_"("_NI(1)_")")=$E($G(@(NARY_"("_NI(1)_")"))_$E(NURQB,1,18),1,18)_" "_$E($G(NURSERVC(NI(1)))_$E(NURQB,1,9),1,9)
.S @NARY=NI
K NCARE S NCARE=0 I ND3>0 F I=1:1:ND3 D
.S NARY="NCARE"_I,J=@NARY
.F K=1:1:J S NCARE=NCARE+1,NCARE(NCARE)=@(NARY_"("_K_")")
S:NCARE>NLEVL NLEVL=NCARE
Q
PRACT K NURSERVP S ND3=0 F D3=0:0 S D3=$O(^NURQ(217,DA,2,D1,2,D2,2,D3)) Q:D3'>0 N X S NURSERVP=+$P($G(^(D3,0)),"^"),NURSERVP(1)=$$GET1^DIQ(49,+$P($G(^NURQ(217.1,+NURSERVP,1)),"^",2),.01,"I"),X=$G(^NURQ(217.1,+NURSERVP,0)) D
.S DIWF="",DIWL=0,DIWR=19 K ^UTILITY($J) D ^DIWP S NARY="NPRACT"_D3,ND3=D3 K @NARY S @NARY=0 D MERGE^NURQRPT3(.@NARY,18)
.N X S X=NURSERVP(1) K NURSERVP S NURSERVP=0,DIWF="",DIWL=0,DIWR=9 K ^UTILITY($J) D ^DIWP,MERGE^NURQRPT3(.NURSERVP,9)
.S NI=$S(@NARY>NURSERVP:@NARY,1:NURSERVP)
.F NI(1)=1:1:NI S @(NARY_"("_NI(1)_")")=$E($G(@(NARY_"("_NI(1)_")"))_$E(NURQB,1,18),1,18)_" "_$E($G(NURSERVP(NI(1)))_$E(NURQB,1,9),1,9)
.S @NARY=NI
K NPRACT S NPRACT=0 I ND3>0 F I=1:1:ND3 D
.S NARY="NPRACT"_I,J=@NARY
.F K=1:1:J S NPRACT=NPRACT+1,NPRACT(NPRACT)=@(NARY_"("_K_")")
S:NPRACT>NLEVL NLEVL=NPRACT
S:NURSERVP>NLEVL NLEVL=NURSERVP
Q
DATA ;PRINT DATA INFORMATION
W !,"B. DATA:" I $D(^NURQ(217,DA,5,0)),$P($G(^(0)),"^",3)>0 D
.S NURQTXT=" 1. DATA SOURCE: " F D1=0:0 S D1=$O(^NURQ(217,DA,5,D1)) Q:D1'>0!$G(NUROUT) I $P($G(^NURQ(217,DA,5,D1,0)),"^")'="" S NURQTXT=NURQTXT_" "_$P(^(0),"^")
.S NURQTXT(1)=$E(NURQB,1,6) D DIWP^NURQRPT3(.NURQTXT)
E W !,?3,"1. DATA SOURCE:"
;PRINT SAMPLE SIZE
Q:$G(NUROUT) W !,?3,"2. SAMPLE SIZE: "_$S($P($G(^NURQ(217,DA,7)),"^")'="":$P(^(7),"^"),1:"")
;PRINT METHODOLOGY
Q:$G(NUROUT) I $D(^NURQ(217,DA,6,0)),$P($G(^(0)),"^",3)>0 D
.S NURQTXT=" 3. METHODOLOGY:" F D1=0:0 S D1=$O(^NURQ(217,DA,6,D1)) Q:D1'>0 I $P($G(^NURQ(217,DA,6,D1,0)),"^")'="" S NURQTXT=NURQTXT_" "_$P($G(^(0)),"^")
.S NURQTXT(1)=$E(NURQB,1,6) D DIWP^NURQRPT3(.NURQTXT)
E W !,?3,"3. METHODOLOGY:"
S NURQFREQ=$S($D(^NURQ(217.3,+$P($G(^NURQ(217,DA,7)),"^",2),0)):$P(^(0),"^"),1:"") D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W !,?3,"4. FREQUENCY: "_NURQFREQ
Q:$G(NUROUT) S NURQTXT=" 5. MONITORING PERIOD: "_$P($G(^NURQ(217,DA,7)),"^",3) D DIWP^NURQRPT3(.NURQTXT)
Q:$G(NUROUT) D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W !,?3,"6. SURVEY STATISTICS: " S (NURDEM,NURQWRD)=0 D ^NURQUTL3
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURQRPT1 4997 printed Dec 13, 2024@02:21:10 Page 2
NURQRPT1 ;HIRMFO/YH-QI SUMMARY REPORT, PART 2 ;4/22/96
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 DO HDR^NURQRPT0
if $GET(NUROUT)
QUIT
SET NURQB=""
SET $PIECE(NURQB," ",40)=""
+1 SET NURQTXT="A. DISCIPLINES: "_$SELECT($DATA(NURQAR)&($DATA(NURQSRVC)):NURQAR_", "_$$GET1^DIQ(49,+NURQSRVC,.01,"I"),1:"")
SET NURQTXT(1)=$EXTRACT(NURQB,1,4)
DO DIWP^NURQRPT3(.NURQTXT)
+2 if $GET(NUROUT)
QUIT
DO DATA
if $GET(NUROUT)
QUIT
DO RECEIVR^NURQRPT2
if $GET(NUROUT)
QUIT
DO REFER^NURQRPT3
+3 if $GET(NUROUT)
QUIT
WRITE !!,?40,"ENTERED BY: "
IF $DATA(^VA(200,+NURQND,0))
IF $PIECE(^(0),"^")'=""
WRITE $PIECE(^(0),"^")
+4 WRITE !,"F. LOCATION INFORMATION:"
DO LOC
+5 QUIT
LOC ;PRINT DATA FOR EACH UNIT
+1 IF $GET(NUREQWRD)
IF '$DATA(^NURQ(217,DA,2,"B",+NUREQWRD))
if ($Y>(IOSL-7))
DO HDR^NURQRPT0
WRITE !,?3,"No location information entered for "_$SELECT($DATA(^SC(+NUREQWRD,0)):$PIECE($PIECE($GET(^(0)),"^"),"NUR ",2),1:" "),!
QUIT
+2 SET (D1,D1(1))=0
FOR
SET D1=$ORDER(NUREQWRD(D1))
if D1'>0!$GET(NUROUT)
QUIT
SET NURQWRD=$PIECE(NUREQWRD(D1),"^")
SET D1(1)=D1(1)+1
Begin DoDot:1
+3 if ($Y>(IOSL-7))
DO HDR^NURQRPT0
if $GET(NUROUT)
QUIT
WRITE !!,?3,"**********",!,?3,D1(1)_". "_$PIECE(NUREQWRD(D1),"^",2)
+4 WRITE !,?6,"A. SURVEY STATISTCS:"
+5 SET NURDEM=$$SURLOC^NURQUTL1(NURQSVN)
if 'NURDEM&($Y>(IOSL-7))
DO HDR^NURQRPT0
if $GET(NUROUT)
QUIT
if 'NURDEM
WRITE !!,?9,"No statistics data for this unit",!
if NURDEM
DO ^NURQUTL3
+6 if $GET(NUROUT)
QUIT
if ($Y>(IOSL-7))
DO HDR^NURQRPT0
if $GET(NUROUT)
QUIT
WRITE !,?6,"B. IMPORTANT FUNCTIONS:"
+7 DO IMPORTNT
if $GET(NUROUT)
QUIT
+8 if ($Y>(IOSL-7))
DO HDR^NURQRPT0
if $GET(NUROUT)
QUIT
WRITE !!,?6,"C. PERFORMANCE MEASUREMENTS:"
DO PERFORM^NURQRPT4
+9 QUIT
End DoDot:1
+10 QUIT
IMPORTNT ;PRINT IMPORTANT FUNCTION
+1 if ($Y>(IOSL-7))
DO HDR^NURQRPT0
if $GET(NUROUT)
QUIT
WRITE !
DO FHEADR^NURQRPT0
+2 if $GET(NUROUT)
QUIT
IF $PIECE($GET(^NURQ(217,DA,2,D1,2,0)),"^",4)>0
Begin DoDot:1
+3 SET NLEVL=0
FOR D2=0:0
SET D2=$ORDER(^NURQ(217,DA,2,D1,2,D2))
if D2'>0!$GET(NUROUT)
QUIT
KILL ^UTILITY($JOB)
NEW X
SET X=$PIECE($GET(^NURQ(217,DA,2,D1,2,D2,0)),"^")
SET DIWF=""
SET DIWL=0
SET DIWR=20
DO ^DIWP
KILL NFUNC
SET NFUNC=0
DO MERGE^NURQRPT3(.NFUNC,19)
if $GET(NLEVL)<NFUNC
SET NLEVL=NFUNC
Begin DoDot:2
+4 IF $PIECE($GET(^NURQ(217,DA,2,D1,2,D2,1,0)),"^",3)>0
DO CARE
+5 if $GET(NUROUT)
QUIT
IF $PIECE($GET(^NURQ(217,DA,2,D1,2,D2,2,0)),"^",3)>0
DO PRACT
+6 if $GET(NUROUT)
QUIT
IF NLEVL>0
DO WRITE^NURQRPT3
QUIT
+7 IF '$TEST
WRITE !,"No Important Function entered"
End DoDot:2
End DoDot:1
+8 KILL NCARE1,NCARE2,NPRACT1,NPRACT2,ND3,K,NURSERVC,NURSERVP
QUIT
CARE KILL NURSERVC
SET ND3=0
FOR D3=0:0
SET D3=$ORDER(^NURQ(217,DA,2,D1,2,D2,1,D3))
if D3'>0!$GET(NUROUT)
QUIT
NEW X
SET NURSERVC=+$PIECE($GET(^(D3,0)),"^")
SET NURSERVC(1)=$$GET1^DIQ(49,+$PIECE($GET(^NURQ(217.1,+NURSERVC,1)),"^",2),.01,"I")
SET X=$GET(^NURQ(217.1,+NURSERVC,0))
Begin DoDot:1
+1 SET DIWF=""
SET DIWL=0
SET DIWR=18
KILL ^UTILITY($JOB)
DO ^DIWP
SET NARY="NCARE"_D3
SET ND3=D3
KILL @NARY
SET @NARY=0
DO MERGE^NURQRPT3(.@NARY,18)
+2 NEW X
SET X=NURSERVC(1)
KILL NSERCV
SET NURSERVC=0
SET DIWF=""
SET DIWL=0
SET DIWR=9
KILL ^UTILITY($JOB)
DO ^DIWP
DO MERGE^NURQRPT3(.NURSERVC,9)
+3 SET NI=$SELECT(@NARY>NURSERVC:@NARY,1:NURSERVC)
+4 FOR NI(1)=1:1:NI
SET @(NARY_"("_NI(1)_")")=$EXTRACT($GET(@(NARY_"("_NI(1)_")"))_$EXTRACT(NURQB,1,18),1,18)_" "_$EXTRACT($GET(NURSERVC(NI(1)))_$EXTRACT(NURQB,1,9),1,9)
+5 SET @NARY=NI
End DoDot:1
+6 KILL NCARE
SET NCARE=0
IF ND3>0
FOR I=1:1:ND3
Begin DoDot:1
+7 SET NARY="NCARE"_I
SET J=@NARY
+8 FOR K=1:1:J
SET NCARE=NCARE+1
SET NCARE(NCARE)=@(NARY_"("_K_")")
End DoDot:1
+9 if NCARE>NLEVL
SET NLEVL=NCARE
+10 QUIT
PRACT KILL NURSERVP
SET ND3=0
FOR D3=0:0
SET D3=$ORDER(^NURQ(217,DA,2,D1,2,D2,2,D3))
if D3'>0
QUIT
NEW X
SET NURSERVP=+$PIECE($GET(^(D3,0)),"^")
SET NURSERVP(1)=$$GET1^DIQ(49,+$PIECE($GET(^NURQ(217.1,+NURSERVP,1)),"^",2),.01,"I")
SET X=$GET(^NURQ(217.1,+NURSERVP,0))
Begin DoDot:1
+1 SET DIWF=""
SET DIWL=0
SET DIWR=19
KILL ^UTILITY($JOB)
DO ^DIWP
SET NARY="NPRACT"_D3
SET ND3=D3
KILL @NARY
SET @NARY=0
DO MERGE^NURQRPT3(.@NARY,18)
+2 NEW X
SET X=NURSERVP(1)
KILL NURSERVP
SET NURSERVP=0
SET DIWF=""
SET DIWL=0
SET DIWR=9
KILL ^UTILITY($JOB)
DO ^DIWP
DO MERGE^NURQRPT3(.NURSERVP,9)
+3 SET NI=$SELECT(@NARY>NURSERVP:@NARY,1:NURSERVP)
+4 FOR NI(1)=1:1:NI
SET @(NARY_"("_NI(1)_")")=$EXTRACT($GET(@(NARY_"("_NI(1)_")"))_$EXTRACT(NURQB,1,18),1,18)_" "_$EXTRACT($GET(NURSERVP(NI(1)))_$EXTRACT(NURQB,1,9),1,9)
+5 SET @NARY=NI
End DoDot:1
+6 KILL NPRACT
SET NPRACT=0
IF ND3>0
FOR I=1:1:ND3
Begin DoDot:1
+7 SET NARY="NPRACT"_I
SET J=@NARY
+8 FOR K=1:1:J
SET NPRACT=NPRACT+1
SET NPRACT(NPRACT)=@(NARY_"("_K_")")
End DoDot:1
+9 if NPRACT>NLEVL
SET NLEVL=NPRACT
+10 if NURSERVP>NLEVL
SET NLEVL=NURSERVP
+11 QUIT
DATA ;PRINT DATA INFORMATION
+1 WRITE !,"B. DATA:"
IF $DATA(^NURQ(217,DA,5,0))
IF $PIECE($GET(^(0)),"^",3)>0
Begin DoDot:1
+2 SET NURQTXT=" 1. DATA SOURCE: "
FOR D1=0:0
SET D1=$ORDER(^NURQ(217,DA,5,D1))
if D1'>0!$GET(NUROUT)
QUIT
IF $PIECE($GET(^NURQ(217,DA,5,D1,0)),"^")'=""
SET NURQTXT=NURQTXT_" "_$PIECE(^(0),"^")
+3 SET NURQTXT(1)=$EXTRACT(NURQB,1,6)
DO DIWP^NURQRPT3(.NURQTXT)
End DoDot:1
+4 IF '$TEST
WRITE !,?3,"1. DATA SOURCE:"
+5 ;PRINT SAMPLE SIZE
+6 if $GET(NUROUT)
QUIT
WRITE !,?3,"2. SAMPLE SIZE: "_$SELECT($PIECE($GET(^NURQ(217,DA,7)),"^")'="":$PIECE(^(7),"^"),1:"")
+7 ;PRINT METHODOLOGY
+8 if $GET(NUROUT)
QUIT
IF $DATA(^NURQ(217,DA,6,0))
IF $PIECE($GET(^(0)),"^",3)>0
Begin DoDot:1
+9 SET NURQTXT=" 3. METHODOLOGY:"
FOR D1=0:0
SET D1=$ORDER(^NURQ(217,DA,6,D1))
if D1'>0
QUIT
IF $PIECE($GET(^NURQ(217,DA,6,D1,0)),"^")'=""
SET NURQTXT=NURQTXT_" "_$PIECE($GET(^(0)),"^")
+10 SET NURQTXT(1)=$EXTRACT(NURQB,1,6)
DO DIWP^NURQRPT3(.NURQTXT)
End DoDot:1
+11 IF '$TEST
WRITE !,?3,"3. METHODOLOGY:"
+12 SET NURQFREQ=$SELECT($DATA(^NURQ(217.3,+$PIECE($GET(^NURQ(217,DA,7)),"^",2),0)):$PIECE(^(0),"^"),1:"")
if ($Y>(IOSL-7))
DO HDR^NURQRPT0
if $GET(NUROUT)
QUIT
WRITE !,?3,"4. FREQUENCY: "_NURQFREQ
+13 if $GET(NUROUT)
QUIT
SET NURQTXT=" 5. MONITORING PERIOD: "_$PIECE($GET(^NURQ(217,DA,7)),"^",3)
DO DIWP^NURQRPT3(.NURQTXT)
+14 if $GET(NUROUT)
QUIT
if ($Y>(IOSL-7))
DO HDR^NURQRPT0
if $GET(NUROUT)
QUIT
WRITE !,?3,"6. SURVEY STATISTICS: "
SET (NURDEM,NURQWRD)=0
DO ^NURQUTL3
+15 QUIT
