source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURQRPT1.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1NURQRPT1 ;HIRMFO/YH-QI SUMMARY REPORT, PART 2 ;4/22/96
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 D HDR^NURQRPT0 Q:$G(NUROUT) S NURQB="",$P(NURQB," ",40)=""
4 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)
5 Q:$G(NUROUT) D DATA Q:$G(NUROUT) D RECEIVR^NURQRPT2 Q:$G(NUROUT) D REFER^NURQRPT3
6 Q:$G(NUROUT) W !!,?40,"ENTERED BY: " I $D(^VA(200,+NURQND,0)),$P(^(0),"^")'="" W $P(^(0),"^")
7 W !,"F. LOCATION INFORMATION:" D LOC
8 Q
9LOC ;PRINT DATA FOR EACH UNIT
10 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
11 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
12 .D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W !!,?3,"**********",!,?3,D1(1)_". "_$P(NUREQWRD(D1),"^",2)
13 .W !,?6,"A. SURVEY STATISTCS:"
14 .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
15 .Q:$G(NUROUT) D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W !,?6,"B. IMPORTANT FUNCTIONS:"
16 .D IMPORTNT Q:$G(NUROUT)
17 .D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W !!,?6,"C. PERFORMANCE MEASUREMENTS:" D PERFORM^NURQRPT4
18 .Q
19 Q
20IMPORTNT ;PRINT IMPORTANT FUNCTION
21 D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W ! D FHEADR^NURQRPT0
22 Q:$G(NUROUT) I $P($G(^NURQ(217,DA,2,D1,2,0)),"^",4)>0 D
23 .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
24 ..I $P($G(^NURQ(217,DA,2,D1,2,D2,1,0)),"^",3)>0 D CARE
25 ..Q:$G(NUROUT) I $P($G(^NURQ(217,DA,2,D1,2,D2,2,0)),"^",3)>0 D PRACT
26 ..Q:$G(NUROUT) I NLEVL>0 D WRITE^NURQRPT3 Q
27 ..E W !,"No Important Function entered"
28 K NCARE1,NCARE2,NPRACT1,NPRACT2,ND3,K,NURSERVC,NURSERVP Q
29CARE 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
30 .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)
31 .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)
32 .S NI=$S(@NARY>NURSERVC:@NARY,1:NURSERVC)
33 .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)
34 .S @NARY=NI
35 K NCARE S NCARE=0 I ND3>0 F I=1:1:ND3 D
36 .S NARY="NCARE"_I,J=@NARY
37 .F K=1:1:J S NCARE=NCARE+1,NCARE(NCARE)=@(NARY_"("_K_")")
38 S:NCARE>NLEVL NLEVL=NCARE
39 Q
40PRACT 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
41 .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)
42 .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)
43 .S NI=$S(@NARY>NURSERVP:@NARY,1:NURSERVP)
44 .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)
45 .S @NARY=NI
46 K NPRACT S NPRACT=0 I ND3>0 F I=1:1:ND3 D
47 .S NARY="NPRACT"_I,J=@NARY
48 .F K=1:1:J S NPRACT=NPRACT+1,NPRACT(NPRACT)=@(NARY_"("_K_")")
49 S:NPRACT>NLEVL NLEVL=NPRACT
50 S:NURSERVP>NLEVL NLEVL=NURSERVP
51 Q
52DATA ;PRINT DATA INFORMATION
53 W !,"B. DATA:" I $D(^NURQ(217,DA,5,0)),$P($G(^(0)),"^",3)>0 D
54 .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),"^")
55 .S NURQTXT(1)=$E(NURQB,1,6) D DIWP^NURQRPT3(.NURQTXT)
56 E W !,?3,"1. DATA SOURCE:"
57 ;PRINT SAMPLE SIZE
58 Q:$G(NUROUT) W !,?3,"2. SAMPLE SIZE: "_$S($P($G(^NURQ(217,DA,7)),"^")'="":$P(^(7),"^"),1:"")
59 ;PRINT METHODOLOGY
60 Q:$G(NUROUT) I $D(^NURQ(217,DA,6,0)),$P($G(^(0)),"^",3)>0 D
61 .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)),"^")
62 .S NURQTXT(1)=$E(NURQB,1,6) D DIWP^NURQRPT3(.NURQTXT)
63 E W !,?3,"3. METHODOLOGY:"
64 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
65 Q:$G(NUROUT) S NURQTXT=" 5. MONITORING PERIOD: "_$P($G(^NURQ(217,DA,7)),"^",3) D DIWP^NURQRPT3(.NURQTXT)
66 Q:$G(NUROUT) D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W !,?3,"6. SURVEY STATISTICS: " S (NURDEM,NURQWRD)=0 D ^NURQUTL3
67 Q
Note: See TracBrowser for help on using the repository browser.