- NURQRPT2 ;HIRMFO/YH-ROUTINE TO PRINT 10 STEP REPORT, PART 3 ;3/28/96
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- INDTYP ;WRITE TYPE OF INDICATOR DATA FOR EACH STUDY QUESTION
- I $D(^NURQ(217,DA,2,D1,3,D2,2)) S NURQKOI=$P($G(^(2)),"^",4),NURQPO=$P($G(^(2)),"^",5)
- W:$G(NURQKOI)>0 $S(NURQKOI=1:"STRUCTURE",NURQKOI=2:"PROCESS",NURQKOI=3:"OUTCOME",1:"")
- Q
- TERMS ;PACK DEFINITION OF TERMS DATA IN NTXT_NJ ARRAY FOR EACH STUDY QUESTIONS
- ;NJ IS DISPLAY COLUMN
- S X="" F D3=0:0 S D3=$O(^NURQ(217,DA,2,D1,3,D2,12,D3)) Q:D3'>0 S X=X_$S(D3>1:" ",1:"")_$P($G(^(D3,0)),"^")
- K ^UTILITY($J) S DIWF="",DIWL=0,DIWR=19 D ^DIWP S NARY="NTXT"_NJ,@NARY=0 D MERGE^NURQRPT3(.@NARY,19)
- Q
- RATION ;PACK MULTIPLE RATIONALE DATA IN NTXT_NJ ARRAY FOR EACH STUDY QUESTION
- S NARY="NTXT"_NJ,@NARY=0 F D3=0:0 S D3=$O(^NURQ(217,DA,2,D1,3,D2,1,D3)) Q:D3'>0!NUROUT S @NARY=@NARY+1,@(NARY_"("_@NARY_")")=$P($G(^NURQ(217.2,$P($G(^NURQ(217,DA,2,D1,3,D2,1,D3,0)),"^"),0)),"^")
- Q
- METHOD ;SAVE METHOD OF DETERMINING VARIANCE IN NTXT_NJ ARRAY FOR EACH STUDY QUESTION
- S X=$P($G(^NURQ(217,DA,2,D1,3,D2,3)),"^") K ^UTILITY($J) S DIWF="",DIWL=0,DIWR=19 D ^DIWP S NARY="NTXT"_NJ,@NARY=0 D MERGE^NURQRPT3(.@NARY,19)
- Q
- CONCLUD ;SAVE CONCLUSION WP DATA IN TXT_NJ ARRAY FOR EACH STUDY
- S X="" F D3=0:0 S D3=$O(^NURQ(217,DA,2,D1,3,D2,10,D3)) Q:D3'>0 S:X'="" X=X_" " S X=X_$S(D3>1:" ",1:"")_$P($G(^(D3,0)),"^")
- S DIWF="",DIWL=0,DIWR=19 K ^UTILITY($J) S NARY="NTXT"_NJ,@NARY=0 D ^DIWP,MERGE^NURQRPT3(.@NARY,19)
- Q
- RECOMD ;SAVE RECOMMENDATION/ACTION TEXT IN NTXT_NJ ARRAR WHERE NJ IS THE
- ;DISPLAY COLUMN FOR THE STUDY QUESTION
- S X=$P($G(^NURQ(217,DA,2,D1,3,D2,5)),"^"),DIWF="",DIWL=0,DIWR=19 K ^UTILITY($J) S NARY="NTXT"_NJ,@NARY=0 D ^DIWP,MERGE^NURQRPT3(.@NARY,19)
- Q
- GROUP ;SAVE PERSON/GROUP TAKING ACTION TEXT IN NTXT_NJ ARRAY
- ;NJ IS DISPLAY COLUMN
- S X=$P($G(^NURQ(217,DA,2,D1,3,D2,6)),"^"),DIWF="",DIWL=0,DIWR=19 K ^UTILITY($J) S NARY="NTXT"_NJ,@NARY=0 D ^DIWP,MERGE^NURQRPT3(.@NARY,19)
- Q
- DATE ;PRINT DATE IMPLEMENTED
- S X=$P($G(^NURQ(217,DA,2,D1,3,D2,6)),"^",3) W:X>0 $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
- Q
- EFFECT ;EFFECTIVENESS OF ACTION TAKEN
- S NURQ=+$P($G(^NURQ(217,DA,2,D1,3,D2,9)),"^",4) S X="" D
- .I NURQ=1 S X="NO ACTIONS TAKEN" Q
- .I NURQ=2 S X="ACTIONS TAKEN WERE EFFECTIVE IN IMPROVING PATIENT CARE" Q
- .I NURQ=3 S X="ACTIONS TAKEN WERE PARTIALLY EFECTIVE IN IMPROVING PATIENT CARE" Q
- .I NURQ=4 S X="ACTIONS TAKEN WERE NOT EFFECTIVE IN IMPROVING PATIENT CARE"
- S DIWF="",DIWL=0,DIWR=19 K ^UTILITY($J) S NARY="NTXT"_NJ,@NARY=0 D ^DIWP,MERGE^NURQRPT3(.@NARY,19)
- Q
- RECEIVR ;RECEIVER OF RESULTS
- D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:NUROUT W !,"C. RECEIVER OF RESULTS:"
- I $P($G(^NURQ(217,DA,8,0)),"^",3)>0 F D1=0:0 S D1=$O(^NURQ(217,DA,8,D1)) Q:D1'>0!NUROUT D
- .D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:NUROUT W !,?4,$P($G(^NURQ(217,DA,8,D1,0)),"^"),!,?5,"DATE COMMUNICATED: " D COMUN^NURQRPT3
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURQRPT2 2900 printed Jan 18, 2025@03:22:22 Page 2
- NURQRPT2 ;HIRMFO/YH-ROUTINE TO PRINT 10 STEP REPORT, PART 3 ;3/28/96
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- INDTYP ;WRITE TYPE OF INDICATOR DATA FOR EACH STUDY QUESTION
- +1 IF $DATA(^NURQ(217,DA,2,D1,3,D2,2))
- SET NURQKOI=$PIECE($GET(^(2)),"^",4)
- SET NURQPO=$PIECE($GET(^(2)),"^",5)
- +2 if $GET(NURQKOI)>0
- WRITE $SELECT(NURQKOI=1:"STRUCTURE",NURQKOI=2:"PROCESS",NURQKOI=3:"OUTCOME",1:"")
- +3 QUIT
- TERMS ;PACK DEFINITION OF TERMS DATA IN NTXT_NJ ARRAY FOR EACH STUDY QUESTIONS
- +1 ;NJ IS DISPLAY COLUMN
- +2 SET X=""
- FOR D3=0:0
- SET D3=$ORDER(^NURQ(217,DA,2,D1,3,D2,12,D3))
- if D3'>0
- QUIT
- SET X=X_$SELECT(D3>1:" ",1:"")_$PIECE($GET(^(D3,0)),"^")
- +3 KILL ^UTILITY($JOB)
- SET DIWF=""
- SET DIWL=0
- SET DIWR=19
- DO ^DIWP
- SET NARY="NTXT"_NJ
- SET @NARY=0
- DO MERGE^NURQRPT3(.@NARY,19)
- +4 QUIT
- RATION ;PACK MULTIPLE RATIONALE DATA IN NTXT_NJ ARRAY FOR EACH STUDY QUESTION
- +1 SET NARY="NTXT"_NJ
- SET @NARY=0
- FOR D3=0:0
- SET D3=$ORDER(^NURQ(217,DA,2,D1,3,D2,1,D3))
- if D3'>0!NUROUT
- QUIT
- SET @NARY=@NARY+1
- SET @(NARY_"("_@NARY_")")=$PIECE($GET(^NURQ(217.2,$PIECE($GET(^NURQ(217,DA,2,D1,3,D2,1,D3,0)),"^"),0)),"^")
- +2 QUIT
- METHOD ;SAVE METHOD OF DETERMINING VARIANCE IN NTXT_NJ ARRAY FOR EACH STUDY QUESTION
- +1 SET X=$PIECE($GET(^NURQ(217,DA,2,D1,3,D2,3)),"^")
- KILL ^UTILITY($JOB)
- SET DIWF=""
- SET DIWL=0
- SET DIWR=19
- DO ^DIWP
- SET NARY="NTXT"_NJ
- SET @NARY=0
- DO MERGE^NURQRPT3(.@NARY,19)
- +2 QUIT
- CONCLUD ;SAVE CONCLUSION WP DATA IN TXT_NJ ARRAY FOR EACH STUDY
- +1 SET X=""
- FOR D3=0:0
- SET D3=$ORDER(^NURQ(217,DA,2,D1,3,D2,10,D3))
- if D3'>0
- QUIT
- if X'=""
- SET X=X_" "
- SET X=X_$SELECT(D3>1:" ",1:"")_$PIECE($GET(^(D3,0)),"^")
- +2 SET DIWF=""
- SET DIWL=0
- SET DIWR=19
- KILL ^UTILITY($JOB)
- SET NARY="NTXT"_NJ
- SET @NARY=0
- DO ^DIWP
- DO MERGE^NURQRPT3(.@NARY,19)
- +3 QUIT
- RECOMD ;SAVE RECOMMENDATION/ACTION TEXT IN NTXT_NJ ARRAR WHERE NJ IS THE
- +1 ;DISPLAY COLUMN FOR THE STUDY QUESTION
- +2 SET X=$PIECE($GET(^NURQ(217,DA,2,D1,3,D2,5)),"^")
- SET DIWF=""
- SET DIWL=0
- SET DIWR=19
- KILL ^UTILITY($JOB)
- SET NARY="NTXT"_NJ
- SET @NARY=0
- DO ^DIWP
- DO MERGE^NURQRPT3(.@NARY,19)
- +3 QUIT
- GROUP ;SAVE PERSON/GROUP TAKING ACTION TEXT IN NTXT_NJ ARRAY
- +1 ;NJ IS DISPLAY COLUMN
- +2 SET X=$PIECE($GET(^NURQ(217,DA,2,D1,3,D2,6)),"^")
- SET DIWF=""
- SET DIWL=0
- SET DIWR=19
- KILL ^UTILITY($JOB)
- SET NARY="NTXT"_NJ
- SET @NARY=0
- DO ^DIWP
- DO MERGE^NURQRPT3(.@NARY,19)
- +3 QUIT
- DATE ;PRINT DATE IMPLEMENTED
- +1 SET X=$PIECE($GET(^NURQ(217,DA,2,D1,3,D2,6)),"^",3)
- if X>0
- WRITE $EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
- +2 QUIT
- EFFECT ;EFFECTIVENESS OF ACTION TAKEN
- +1 SET NURQ=+$PIECE($GET(^NURQ(217,DA,2,D1,3,D2,9)),"^",4)
- SET X=""
- Begin DoDot:1
- +2 IF NURQ=1
- SET X="NO ACTIONS TAKEN"
- QUIT
- +3 IF NURQ=2
- SET X="ACTIONS TAKEN WERE EFFECTIVE IN IMPROVING PATIENT CARE"
- QUIT
- +4 IF NURQ=3
- SET X="ACTIONS TAKEN WERE PARTIALLY EFECTIVE IN IMPROVING PATIENT CARE"
- QUIT
- +5 IF NURQ=4
- SET X="ACTIONS TAKEN WERE NOT EFFECTIVE IN IMPROVING PATIENT CARE"
- End DoDot:1
- +6 SET DIWF=""
- SET DIWL=0
- SET DIWR=19
- KILL ^UTILITY($JOB)
- SET NARY="NTXT"_NJ
- SET @NARY=0
- DO ^DIWP
- DO MERGE^NURQRPT3(.@NARY,19)
- +7 QUIT
- RECEIVR ;RECEIVER OF RESULTS
- +1 if ($Y>(IOSL-7))
- DO HDR^NURQRPT0
- if NUROUT
- QUIT
- WRITE !,"C. RECEIVER OF RESULTS:"
- +2 IF $PIECE($GET(^NURQ(217,DA,8,0)),"^",3)>0
- FOR D1=0:0
- SET D1=$ORDER(^NURQ(217,DA,8,D1))
- if D1'>0!NUROUT
- QUIT
- Begin DoDot:1
- +3 if ($Y>(IOSL-7))
- DO HDR^NURQRPT0
- if NUROUT
- QUIT
- WRITE !,?4,$PIECE($GET(^NURQ(217,DA,8,D1,0)),"^"),!,?5,"DATE COMMUNICATED: "
- DO COMUN^NURQRPT3
- End DoDot:1
- +4 QUIT