- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURQRPT4 3839 printed Mar 13, 2025@21:26:16 Page 2
- NURQRPT4 ;HIRMFO/YH-ROUTINE TO PRINT 10 STEP REPORT, PART 5 ;5/13/96
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- PERFORM ;PRINT FERFORMANCE MEASUREMENTS. QESTIONS ARE STORED IN NURQY ARRAY BY QUESTION ORDER.
- +1 NEW NTOTAL
- KILL NURQY
- SET NTOTAL=0
- IF $PIECE($GET(^NURQ(217,DA,2,D1,3,0)),"^",4)>0
- Begin DoDot:1
- +2 SET D2=0
- FOR
- SET D2=$ORDER(^NURQ(217,DA,2,D1,3,D2))
- if D2'>0!NUROUT
- QUIT
- IF $DATA(^NURQ(217,DA,2,D1,3,D2,0))
- SET NURQRIND=$PIECE($GET(^(0)),"^")
- SET NURQRIND(1)=$PIECE(NURQRIND,",",4)_","_$PIECE(NURQRIND,",",2)_","
- Begin DoDot:2
- +3 KILL NARRAY
- DO GETS^DIQ(748.26,NURQRIND(1),".01;.015;","","NARRAY")
- IF $DATA(NARRAY(748.26,NURQRIND(1),.015))
- IF NARRAY(748.26,NURQRIND(1),.015)>0
- SET NURQY(NARRAY(748.26,NURQRIND(1),.015))=D2
- Begin DoDot:3
- +4 if NTOTAL<NARRAY(748.26,NURQRIND(1),.015)
- SET NTOTAL=NARRAY(748.26,NURQRIND(1),.015)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +5 IF '$DATA(NURQY)
- WRITE !!,?8,"No survey question was selected",!!
- QUIT
- +6 KILL NQUES
- SET (NI,NI(1))=0
- FOR
- SET NI=$ORDER(NURQY(NI))
- if NI'>0!NUROUT
- QUIT
- SET NI(1)=NI(1)+1
- SET NQUES(NI)=""
- if (NI(1)#3)=0!(NI=NTOTAL)
- Begin DoDot:1
- +7 DO QHEAD
- IF $Y>(IOSL-7)
- DO HDR^NURQRPT0
- if NUROUT
- QUIT
- DO QHEAD
- +8 DO PINDIC
- if NUROUT
- QUIT
- DO PTERM
- if NUROUT
- QUIT
- DO PRATION
- if NUROUT
- QUIT
- DO PMETHOD
- if NUROUT
- QUIT
- DO PCONCL
- if NUROUT
- QUIT
- DO PRECOM
- if NUROUT
- QUIT
- DO PGROUP
- if NUROUT
- QUIT
- DO PDATE
- if NUROUT
- QUIT
- DO PEFFECT
- +9 KILL NQUES
- SET NI(1)=0
- End DoDot:1
- QUIT KILL NP,NURQY,NQUES,NARY,NI,NJ,NORDR,NTXT1,NTXT2,NTXT3,NURQTXT,^UTILITY($JOB)
- QUIT
- +1 ;STORE THREE QUESTIONS DATA IN NTXT1, NTXT2 AND NTXT3, RESPECTIVELY
- PINDIC ;PRINT TYPE OF INDICATION BY QUESTION
- +1 IF $Y>(IOSL-7)
- DO HDR^NURQRPT0
- if NUROUT
- QUIT
- DO QHEAD
- +2 WRITE !,"1. TYPE OF"
- SET (NJ,NORDR)=0
- FOR
- SET NORDR=$ORDER(NQUES(NORDR))
- if NORDR'>0
- QUIT
- SET D2=NURQY(NORDR)
- SET NJ=NJ+1
- SET NI(3)=""
- SET NP="W ?"_$SELECT(NJ=1:"18",NJ=2:"39",NJ=3:"60",1:"")
- XECUTE NP
- DO INDTYP^NURQRPT2
- +3 WRITE !," INDICATOR"
- +4 QUIT
- PTERM ;PRINT DEFINITION OF TERMS BY QUESTIONS
- +1 KILL NTXT1,NTXT2,NTXT3
- SET (NJ,NORDR)=0
- FOR
- SET NORDR=$ORDER(NQUES(NORDR))
- if NORDR'>0
- QUIT
- SET D2=NURQY(NORDR)
- SET NJ=NJ+1
- DO TERMS^NURQRPT2
- +2 SET NLABEL=2
- SET NLABEL(1)="2. DEFINITION"
- SET NLABEL(2)=" OF TERMS"
- DO WRITE
- +3 QUIT
- PRATION ;PRINT RATIONALE
- +1 KILL NTXT1,NTXT2,NTXT3
- SET (NJ,NORDR)=0
- FOR
- SET NORDR=$ORDER(NQUES(NORDR))
- if NORDR'>0
- QUIT
- SET D2=NURQY(NORDR)
- SET NJ=NJ+1
- DO RATION^NURQRPT2
- +2 SET NLABEL=1
- SET NLABEL(1)="3. RATIONALE"
- DO WRITE
- +3 QUIT
- PMETHOD ;
- +1 KILL NTXT1,NTXT2,NTXT3
- SET (NJ,NORDR)=0
- FOR
- SET NORDR=$ORDER(NQUES(NORDR))
- if NORDR'>0
- QUIT
- SET D2=NURQY(NORDR)
- SET NJ=NJ+1
- DO METHOD^NURQRPT2
- +2 SET NLABEL=3
- SET NLABEL(1)="4. METHOD OF"
- SET NLABEL(2)=" DETERMINING"
- SET NLABEL(3)=" VARIANCE"
- DO WRITE
- +3 QUIT
- PCONCL ;PRINT CONCLUSIONS
- +1 KILL NTXT1,NTXT2,NTXT3
- SET (NJ,NORDR)=0
- FOR
- SET NORDR=$ORDER(NQUES(NORDR))
- if NORDR'>0
- QUIT
- SET D2=NURQY(NORDR)
- SET NJ=NJ+1
- DO CONCLUD^NURQRPT2
- +2 SET NLABEL=1
- SET NLABEL(1)="5. CONCLUSIONS"
- DO WRITE
- +3 QUIT
- PRECOM ;
- +1 KILL NTXT1,NTXT2,NTXT3
- SET (NJ,NORDR)=0
- FOR
- SET NORDR=$ORDER(NQUES(NORDR))
- if NORDR'>0
- QUIT
- SET D2=NURQY(NORDR)
- SET NJ=NJ+1
- DO RECOMD^NURQRPT2
- +2 SET NLABEL=2
- SET NLABEL(1)="6. RECOMMENDA-"
- SET NLABEL(2)=" TION/ACTION"
- DO WRITE
- +3 QUIT
- PGROUP ;
- +1 KILL NTXT1,NTXT2,NTXT3
- SET (NJ,NORDR)=0
- FOR
- SET NORDR=$ORDER(NQUES(NORDR))
- if NORDR'>0
- QUIT
- SET D2=NURQY(NORDR)
- SET NJ=NJ+1
- DO GROUP^NURQRPT2
- +2 SET NLABEL=2
- SET NLABEL(1)="7. PERSON/GROUP"
- SET NLABEL(2)=" TAKING ACTION"
- DO WRITE
- +3 QUIT
- PDATE ;
- +1 IF $Y>(IOSL-7)
- DO HDR^NURQRPT0
- if NUROUT
- QUIT
- DO QHEAD
- +2 WRITE !,"8. DATE"
- SET (NJ,NORDR)=0
- FOR
- SET NORDR=$ORDER(NQUES(NORDR))
- if NORDR'>0
- QUIT
- SET D2=NURQY(NORDR)
- SET NJ=NJ+1
- SET NP="W ?"_$SELECT(NJ=1:"18",NJ=2:"39",NJ=3:"60",1:"")
- XECUTE NP
- DO DATE^NURQRPT2
- +3 WRITE !," IMPLEMENTED"
- +4 QUIT
- PEFFECT ;
- +1 KILL NTXT1,NTXT2,NTXT3
- SET (NJ,NORDR)=0
- FOR
- SET NORDR=$ORDER(NQUES(NORDR))
- if NORDR'>0
- QUIT
- SET D2=NURQY(NORDR)
- SET NJ=NJ+1
- DO EFFECT^NURQRPT2
- +2 SET NLABEL=3
- SET NLABEL(1)="9. EFFECTIVENESS"
- SET NLABEL(2)=" OF ACTION"
- SET NLABEL(3)=" TAKEN"
- DO WRITE
- +3 QUIT
- WRITE NEW I
- FOR I="NTXT1","NTXT2","NTXT3"
- IF $DATA(@I)
- IF @I>NLABEL
- SET NLABEL=@I
- +1 FOR I=1:1:NLABEL
- if NUROUT
- QUIT
- Begin DoDot:1
- +2 IF $Y>(IOSL-7)
- DO HDR^NURQRPT0
- if NUROUT
- QUIT
- DO QHEAD
- +3 WRITE !,$GET(NLABEL(I)),?18,$GET(NTXT1(I)),?39,$GET(NTXT2(I)),?60,$GET(NTXT3(I))
- End DoDot:1
- +4 KILL NLABEL
- QUIT
- +5 ;PRINT QUESTION HEADER
- QHEAD NEW NP
- WRITE !!
- SET NJ=0
- SET NI(2)=0
- FOR
- SET NI(2)=$ORDER(NQUES(NI(2)))
- if NI(2)'>0
- QUIT
- SET NJ=NJ+1
- SET NP="W ?"_$SELECT(NJ=1:"18",NJ=2:"39",NJ=3:"60",1:"")
- XECUTE NP
- WRITE "QUESTION #"_NI(2)
- +1 WRITE !,$$REPEAT^XLFSTR("-",80)
- +2 QUIT
