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 Dec 13, 2024@02:21:13 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
