- NURQRPT0 ;HIRMFO/RM,YH-ROUTINE TO PRINT 10 STEP REPORT ;1/22/97 15:28
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ;
- Q:'$$SURGENVR^NURQUTL1(2,1)
- S (NURQPG,NURQSW)=1,(NURQDT,NUROUT,NURQSURV)=0,NURQBYR=""
- S DIC("A")="Select SURVEY: ",DIC="^NURQ(217,",DIC(0)="AEMQ" D ^DIC K DIC
- G:+Y'>0 QUIT S (NURQ,DA)=+Y W !
- D EN1^NURSAUTL G QUIT:$G(NUROUT)
- D EN1^NURSAGSP G:$G(NUROUT) QUIT S DA=NURQ
- DEV ; DEVICE HANDLING
- W ! S %ZIS="Q" D ^%ZIS K %ZIS K:POP IO("Q") G:POP QUIT
- I $D(IO("Q")) K IO("Q") S ZTRTN="START1^NURQRPT0",ZTDESC="Nursing QI Summary Report" D LOOP,^%ZTLOAD G:$D(ZTSK) QUIT
- START1 ; Enter here if report is queued.
- U IO S NURQDT=$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3)
- S %=$G(^NURQ(217,DA,0)),NURQSVN=$P(%,"^"),NURQND=$P(%,"^",3),NURQSRVC=$P(%,"^",4),NURQSURV=$$GET1^DIQ(748,NURQSVN,.01)
- S:$D(^NURQ(217,DA,1)) NURQAR=$P($G(^(1)),"^") S NURQRPT=0
- I +NURHOSP D
- .F D1=0:0 S D1=$O(^NURQ(217,DA,2,D1)) Q:D1'>0!$G(NUROUT) I $D(^NURQ(217,DA,2,D1,0)) S NUREQWRD(D1)=$P(^(0),"^"),NUREQWRD(D1)=NUREQWRD(D1)_"^"_$S($D(^SC(+NUREQWRD(D1),0)):$P($P($G(^(0)),"^"),"NUR ",2),1:"")
- I 'NURHOSP F D1=0:0 S D1=$O(^NURQ(217,DA,2,D1)) Q:D1'>0!$G(NUROUT) S NURSY=+$G(^NURQ(217,DA,2,D1,0)) S NURSX=$P($P($G(^SC(+NURSY,0)),"^"),"NUR ",2) I $G(NURSX)'="",$D(NURSNLOC(NURSX)) D
- .S NUREQWRD(D1)=$P(^NURQ(217,DA,2,D1,0),"^"),NUREQWRD(D1)=NUREQWRD(D1)_"^"_$S($D(^SC(+NUREQWRD(D1),0)):$P($P($G(^(0)),"^"),"NUR ",2),1:"")
- I $D(NUREQWRD) D EN1^NURQRPT1 S NURQRPT=1
- W:NURQRPT=0 !!!,?5,"NO DATA FOR THIS REPORT",!!
- QUIT D CLOSE^NURSUT1,^NURQKILL K NURSZFAC,NURQB,NURQWRD,NURDEM,NURQRPT,NURQI,NURQJ,NURMDSW,NARRAY,NURFAC,NURQTXT,NI,NARY
- Q
- HDR ; EOP and Print Header.
- I $E(IOST)="C",'NURQSW W ! D ENDPG^NURSUT1 Q:$G(NUROUT)
- S NURQSITE=$$GET1^DIQ(4,+DUZ(2),.01,"I")
- W:$E(IOST)="C"!(NURQPG>1) @IOF
- W !,NURQSITE,?60,NURQDT,?70," PAGE: "_NURQPG,!,"QI SUMMARY: "_NURQSURV,!,$$REPEAT^XLFSTR("-",80)
- W ! S NURQPG=NURQPG+1,NURQSW=0 S:$Y>(IOSL-7) NURQSW=1
- Q
- END W !,$C(7),"NO DATA FOR THIS REPORT" D QUIT
- Q
- LOOP F X="NURQPG","NURQSW","NURQDT","NURQSURV","NURQBYR","DA","NURQ","NURHOSP","NURSZAP","NURSZDA","NURSZSP","NWRD","NUROUT","NUREQWRD" S ZTSAVE(X)=""
- Q
- FHEADR ;IMPORTANT FUNCTION HEADER
- W !,?21,"STANDARD",?40,"ASSOC.",?51,"STANDARD",?70,"ASSOC.",!,"FUNCTION",?21,"OF CARE",?40,"SERVICE",?51,"OF PRACTICE",?70,"SERVICE",!,$$REPEAT^XLFSTR("-",80)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURQRPT0 2379 printed Jan 18, 2025@03:22:20 Page 2
- NURQRPT0 ;HIRMFO/RM,YH-ROUTINE TO PRINT 10 STEP REPORT ;1/22/97 15:28
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ;
- +1 if '$$SURGENVR^NURQUTL1(2,1)
- QUIT
- +2 SET (NURQPG,NURQSW)=1
- SET (NURQDT,NUROUT,NURQSURV)=0
- SET NURQBYR=""
- +3 SET DIC("A")="Select SURVEY: "
- SET DIC="^NURQ(217,"
- SET DIC(0)="AEMQ"
- DO ^DIC
- KILL DIC
- +4 if +Y'>0
- GOTO QUIT
- SET (NURQ,DA)=+Y
- WRITE !
- +5 DO EN1^NURSAUTL
- if $GET(NUROUT)
- GOTO QUIT
- +6 DO EN1^NURSAGSP
- if $GET(NUROUT)
- GOTO QUIT
- SET DA=NURQ
- DEV ; DEVICE HANDLING
- +1 WRITE !
- SET %ZIS="Q"
- DO ^%ZIS
- KILL %ZIS
- if POP
- KILL IO("Q")
- if POP
- GOTO QUIT
- +2 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="START1^NURQRPT0"
- SET ZTDESC="Nursing QI Summary Report"
- DO LOOP
- DO ^%ZTLOAD
- if $DATA(ZTSK)
- GOTO QUIT
- START1 ; Enter here if report is queued.
- +1 USE IO
- SET NURQDT=$EXTRACT(DT,4,5)_"-"_$EXTRACT(DT,6,7)_"-"_$EXTRACT(DT,2,3)
- +2 SET %=$GET(^NURQ(217,DA,0))
- SET NURQSVN=$PIECE(%,"^")
- SET NURQND=$PIECE(%,"^",3)
- SET NURQSRVC=$PIECE(%,"^",4)
- SET NURQSURV=$$GET1^DIQ(748,NURQSVN,.01)
- +3 if $DATA(^NURQ(217,DA,1))
- SET NURQAR=$PIECE($GET(^(1)),"^")
- SET NURQRPT=0
- +4 IF +NURHOSP
- Begin DoDot:1
- +5 FOR D1=0:0
- SET D1=$ORDER(^NURQ(217,DA,2,D1))
- if D1'>0!$GET(NUROUT)
- QUIT
- IF $DATA(^NURQ(217,DA,2,D1,0))
- SET NUREQWRD(D1)=$PIECE(^(0),"^")
- SET NUREQWRD(D1)=NUREQWRD(D1)_"^"_$SELECT($DATA(^SC(+NUREQWRD(D1),0)):$PIECE($PIECE($GET(^(0)),"^"),"NUR ",2),1:"")
- End DoDot:1
- +6 IF 'NURHOSP
- FOR D1=0:0
- SET D1=$ORDER(^NURQ(217,DA,2,D1))
- if D1'>0!$GET(NUROUT)
- QUIT
- SET NURSY=+$GET(^NURQ(217,DA,2,D1,0))
- SET NURSX=$PIECE($PIECE($GET(^SC(+NURSY,0)),"^"),"NUR ",2)
- IF $GET(NURSX)'=""
- IF $DATA(NURSNLOC(NURSX))
- Begin DoDot:1
- +7 SET NUREQWRD(D1)=$PIECE(^NURQ(217,DA,2,D1,0),"^")
- SET NUREQWRD(D1)=NUREQWRD(D1)_"^"_$SELECT($DATA(^SC(+NUREQWRD(D1),0)):$PIECE($PIECE($GET(^(0)),"^"),"NUR ",2),1:"")
- End DoDot:1
- +8 IF $DATA(NUREQWRD)
- DO EN1^NURQRPT1
- SET NURQRPT=1
- +9 if NURQRPT=0
- WRITE !!!,?5,"NO DATA FOR THIS REPORT",!!
- QUIT DO CLOSE^NURSUT1
- DO ^NURQKILL
- KILL NURSZFAC,NURQB,NURQWRD,NURDEM,NURQRPT,NURQI,NURQJ,NURMDSW,NARRAY,NURFAC,NURQTXT,NI,NARY
- +1 QUIT
- HDR ; EOP and Print Header.
- +1 IF $EXTRACT(IOST)="C"
- IF 'NURQSW
- WRITE !
- DO ENDPG^NURSUT1
- if $GET(NUROUT)
- QUIT
- +2 SET NURQSITE=$$GET1^DIQ(4,+DUZ(2),.01,"I")
- +3 if $EXTRACT(IOST)="C"!(NURQPG>1)
- WRITE @IOF
- +4 WRITE !,NURQSITE,?60,NURQDT,?70," PAGE: "_NURQPG,!,"QI SUMMARY: "_NURQSURV,!,$$REPEAT^XLFSTR("-",80)
- +5 WRITE !
- SET NURQPG=NURQPG+1
- SET NURQSW=0
- if $Y>(IOSL-7)
- SET NURQSW=1
- +6 QUIT
- END WRITE !,$CHAR(7),"NO DATA FOR THIS REPORT"
- DO QUIT
- +1 QUIT
- LOOP FOR X="NURQPG","NURQSW","NURQDT","NURQSURV","NURQBYR","DA","NURQ","NURHOSP","NURSZAP","NURSZDA","NURSZSP","NWRD","NUROUT","NUREQWRD"
- SET ZTSAVE(X)=""
- +1 QUIT
- FHEADR ;IMPORTANT FUNCTION HEADER
- +1 WRITE !,?21,"STANDARD",?40,"ASSOC.",?51,"STANDARD",?70,"ASSOC.",!,"FUNCTION",?21,"OF CARE",?40,"SERVICE",?51,"OF PRACTICE",?70,"SERVICE",!,$$REPEAT^XLFSTR("-",80)
- +2 QUIT