source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURQRPT4.m@ 811

NURQRPT4 ;HIRMFO/YH-ROUTINE TO PRINT 10 STEP REPORT, PART 5 ;5/13/96
 ;;4.0;NURSING SERVICE;;Apr 25, 1997
PERFORM ;PRINT FERFORMANCE MEASUREMENTS. QESTIONS ARE STORED IN NURQY ARRAY BY QUESTION ORDER.
 N NTOTAL K NURQY S NTOTAL=0 I $P($G(^NURQ(217,DA,2,D1,3,0)),"^",4)>0 D
 .S D2=0 F  S D2=$O(^NURQ(217,DA,2,D1,3,D2)) Q:D2'>0!NUROUT  I $D(^NURQ(217,DA,2,D1,3,D2,0)) S NURQRIND=$P($G(^(0)),"^"),NURQRIND(1)=$P(NURQRIND,",",4)_","_$P(NURQRIND,",",2)_"," D
 ..K NARRAY D GETS^DIQ(748.26,NURQRIND(1),".01;.015;","","NARRAY") I $D(NARRAY(748.26,NURQRIND(1),.015)),NARRAY(748.26,NURQRIND(1),.015)>0 S NURQY(NARRAY(748.26,NURQRIND(1),.015))=D2 D
 ...S:NTOTAL<NARRAY(748.26,NURQRIND(1),.015) NTOTAL=NARRAY(748.26,NURQRIND(1),.015)
 I '$D(NURQY) W !!,?8,"No survey question was selected",!! Q
 K NQUES S (NI,NI(1))=0 F  S NI=$O(NURQY(NI)) Q:NI'>0!NUROUT  S NI(1)=NI(1)+1,NQUES(NI)="" D:(NI(1)#3)=0!(NI=NTOTAL)
 .D QHEAD I $Y>(IOSL-7) D HDR^NURQRPT0 Q:NUROUT  D QHEAD
 .D PINDIC Q:NUROUT  D PTERM Q:NUROUT  D PRATION Q:NUROUT  D PMETHOD Q:NUROUT  D PCONCL Q:NUROUT  D PRECOM Q:NUROUT  D PGROUP Q:NUROUT  D PDATE Q:NUROUT  D PEFFECT
 .K NQUES S NI(1)=0
QUIT K NP,NURQY,NQUES,NARY,NI,NJ,NORDR,NTXT1,NTXT2,NTXT3,NURQTXT,^UTILITY($J) Q
 ;STORE THREE QUESTIONS DATA IN NTXT1, NTXT2 AND NTXT3, RESPECTIVELY
PINDIC ;PRINT TYPE OF INDICATION BY QUESTION
 I $Y>(IOSL-7) D HDR^NURQRPT0 Q:NUROUT  D QHEAD
  W !,"1. TYPE OF" S (NJ,NORDR)=0 F  S NORDR=$O(NQUES(NORDR)) Q:NORDR'>0  S D2=NURQY(NORDR),NJ=NJ+1,NI(3)="" S NP="W ?"_$S(NJ=1:"18",NJ=2:"39",NJ=3:"60",1:"") X NP D INDTYP^NURQRPT2
 W !,"   INDICATOR"
 Q
PTERM ;PRINT DEFINITION OF TERMS BY QUESTIONS
 K NTXT1,NTXT2,NTXT3 S (NJ,NORDR)=0 F  S NORDR=$O(NQUES(NORDR)) Q:NORDR'>0  S D2=NURQY(NORDR),NJ=NJ+1 D TERMS^NURQRPT2
 S NLABEL=2,NLABEL(1)="2. DEFINITION",NLABEL(2)="   OF TERMS" D WRITE
 Q
PRATION ;PRINT RATIONALE
 K NTXT1,NTXT2,NTXT3 S (NJ,NORDR)=0 F  S NORDR=$O(NQUES(NORDR)) Q:NORDR'>0  S D2=NURQY(NORDR),NJ=NJ+1 D RATION^NURQRPT2
 S NLABEL=1,NLABEL(1)="3. RATIONALE" D WRITE
 Q
PMETHOD ;
 K NTXT1,NTXT2,NTXT3 S (NJ,NORDR)=0 F  S NORDR=$O(NQUES(NORDR)) Q:NORDR'>0  S D2=NURQY(NORDR),NJ=NJ+1 D METHOD^NURQRPT2
 S NLABEL=3,NLABEL(1)="4. METHOD OF",NLABEL(2)="   DETERMINING",NLABEL(3)="   VARIANCE" D WRITE
 Q
PCONCL ;PRINT CONCLUSIONS
 K NTXT1,NTXT2,NTXT3 S (NJ,NORDR)=0 F  S NORDR=$O(NQUES(NORDR)) Q:NORDR'>0  S D2=NURQY(NORDR),NJ=NJ+1 D CONCLUD^NURQRPT2
 S NLABEL=1,NLABEL(1)="5. CONCLUSIONS" D WRITE
 Q
PRECOM ;
 K NTXT1,NTXT2,NTXT3 S (NJ,NORDR)=0 F  S NORDR=$O(NQUES(NORDR)) Q:NORDR'>0  S D2=NURQY(NORDR),NJ=NJ+1 D RECOMD^NURQRPT2
 S NLABEL=2,NLABEL(1)="6. RECOMMENDA-",NLABEL(2)="   TION/ACTION" D WRITE
 Q
PGROUP ;
 K NTXT1,NTXT2,NTXT3 S (NJ,NORDR)=0 F  S NORDR=$O(NQUES(NORDR)) Q:NORDR'>0  S D2=NURQY(NORDR),NJ=NJ+1 D GROUP^NURQRPT2
 S NLABEL=2,NLABEL(1)="7. PERSON/GROUP",NLABEL(2)="   TAKING ACTION" D WRITE
 Q
PDATE ;
 I $Y>(IOSL-7) D HDR^NURQRPT0 Q:NUROUT  D QHEAD
 W !,"8. DATE" S (NJ,NORDR)=0 F  S NORDR=$O(NQUES(NORDR)) Q:NORDR'>0  S D2=NURQY(NORDR),NJ=NJ+1 S NP="W ?"_$S(NJ=1:"18",NJ=2:"39",NJ=3:"60",1:"") X NP D DATE^NURQRPT2
 W !,"   IMPLEMENTED"
 Q
PEFFECT ;
 K NTXT1,NTXT2,NTXT3 S (NJ,NORDR)=0 F  S NORDR=$O(NQUES(NORDR)) Q:NORDR'>0  S D2=NURQY(NORDR),NJ=NJ+1 D EFFECT^NURQRPT2
 S NLABEL=3,NLABEL(1)="9. EFFECTIVENESS",NLABEL(2)="   OF ACTION",NLABEL(3)="   TAKEN" D WRITE
 Q
WRITE N I F I="NTXT1","NTXT2","NTXT3" I $D(@I),@I>NLABEL S NLABEL=@I
 F I=1:1:NLABEL Q:NUROUT  D
 .I $Y>(IOSL-7) D HDR^NURQRPT0 Q:NUROUT  D QHEAD
 .W !,$G(NLABEL(I)),?18,$G(NTXT1(I)),?39,$G(NTXT2(I)),?60,$G(NTXT3(I))
 K NLABEL Q
 ;PRINT QUESTION HEADER
QHEAD N NP W !! S NJ=0,NI(2)=0 F  S NI(2)=$O(NQUES(NI(2))) Q:NI(2)'>0  S NJ=NJ+1 S NP="W ?"_$S(NJ=1:"18",NJ=2:"39",NJ=3:"60",1:"") X NP W "QUESTION #"_NI(2)
 W !,$$REPEAT^XLFSTR("-",80)
 Q