- NURQUTL3 ;HIRMFO/RM,YH-SURVEY STATISTICS PART 1 ;4/22/96
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- PRINT ;
- K ^TMP($J) S (NURTPRT,NURANS)=0,(NBYPASS,NPASSNA)=1
- S NURSITE=$P($$SITE^VASITE,"^",2)
- K ^TMP("DILIST",$J),^TMP("NURQ1",$J) D FIND^DIC(748.3,"",".01;3","MX",$$GET1^DIQ(748,NURQSVN,.01,"E"),"","B","I $$GET1^DIQ(748.3,+Y,.01,""I"")=NURQSVN")
- S NURQI=0 F S NURQI=$O(^TMP("DILIST",$J,2,NURQI)) Q:NURQI'>0 S NPART=$G(^TMP("DILIST",$J,2,NURQI)) Q:NPART="" D
- .Q:$G(^TMP("DILIST",$J,"ID",NURQI,3))'="COMPLETED" ;only completed responses
- .S NLPART=NPART K ^TMP("NURQ1",$J) D GETS^DIQ(748.3,NPART_",","**","","^TMP(""NURQ1"",$J)") Q:NURQWRD>0&(NURQWRD'=$P($G(^TMP("NURQ1",$J,748.36,"1,"_NPART_",",1)),"^"))
- .S NURQJ="" F S NURQJ=$O(^TMP("NURQ1",$J,748.31,NURQJ)) Q:NURQJ="" S NURNUM=$P(NURQJ,",") I NURNUM>0 S NANS=$G(^TMP("NURQ1",$J,748.31,NURQJ,1)) D
- ..I NANS="",$G(^TMP("NURQ1",$J,748.31,NURQJ,2))="" Q ;aborted WP response
- ..I NANS="",$G(^TMP("NURQ1",$J,748.31,NURQJ,2))]"" S ^TMP($J,NURNUM,"WP")="WP"_U_NURNUM Q
- ..I NANS]"" S:'$D(^TMP($J,NURNUM,NANS)) ^TMP($J,NURNUM,NANS)="0^" S $P(^TMP($J,NURNUM,NANS),U,1)=$P(^TMP($J,NURNUM,NANS),U,1)+1,NPQUES=$G(^TMP("NURQ1",$J,748.31,NURQJ,.01)) ;NPQUES is the question pointer
- ..I +NANS>0 S %=$$GET1^DIQ(748.28,NANS_","_NPQUES_","_NURQSVN_",",.01),$P(^TMP($J,NURNUM,NANS),U,2)=$S(%]"":%,1:NANS)
- ..I +NANS=0 S %=$$GET1^DIQ(748.28,($A(NANS)-96)_","_NPQUES_","_NURQSVN_",",.01),$P(^TMP($J,NURNUM,NANS),U,2)=$S(%]"":%,1:NANS)
- ..Q
- .S NURTPRT=NURTPRT+1,^TMP($J,"QAPZ",NPART)=""
- .Q
- ;NLPART is the ifn of the last participant examined. It is kept
- ;as a link to file 748.3
- I NURTPRT=0 D:($Y>(IOSL-7)) HDR^NURQRPT0 G:NUROUT EXIT W !!?10,"No one has yet participated in this survey.",! G EXIT
- ;print the question
- K ^TMP("DILIST",$J),^TMP("NURQ2",$J)
- D LIST^DIC(748.26,","_NURQSVN_",",".015")
- S NURQI=0 F S NURQI=$O(^TMP("DILIST",$J,"ID",NURQI)) Q:NURQI'>0!$G(NUROUT) S NDISP=$G(^TMP("DILIST",$J,"ID",NURQI,.015)),NURNUM=$G(^TMP("DILIST",$J,2,NURQI)) I NDISP>0,NURNUM>0 S ^TMP("NURQ2",$J,NURQSVN,NDISP,NURNUM)=""
- F NDISP=0:0 S NDISP=$O(^TMP("NURQ2",$J,NURQSVN,NDISP)) Q:NDISP=""!$G(NUROUT) F NURNUM=0:0 S NURNUM=$O(^TMP("NURQ2",$J,NURQSVN,NDISP,NURNUM)) Q:NURNUM'>0!$G(NUROUT) DO W !
- .D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT)
- .K ^TMP("NURQ3",$J) D GETS^DIQ(748.26,NURNUM_","_NURQSVN_",","**","","^TMP(""NURQ3"",$J)") ;NDISP=QUESTION ORDER NUMBER, NURNUM=QUESTION NUMBER
- .W !,NDISP,") " F I=0:0 S I=$O(^TMP("NURQ3",$J,748.26,NURNUM_","_NURQSVN_",",.05,I)) D:I=""!(+I=0) Q:I=""!(+I=0)!$G(NUROUT) S X=$G(^TMP("NURQ3",$J,748.26,NURNUM_","_NURQSVN_",",.05,I)) W X,!
- ..S NSTYPE=$G(^TMP("NURQ3",$J,748.26,NURNUM_","_NURQSVN_",",.025)),NGRDIENT=$G(^(0.027)) I NSTYPE="LIKERT SCALE" S NURQUES=NURNUM D LIKRTLAB^NURQUTL2 K NURQUES
- ..;;FINDS THE IEN FOR A QUESTION NUMBER IN THE SURVEY RESPONSE DATA #748.3 FILE
- ..;;SET NURQUES = IEN
- ..K ^TMP("DILIST",$J) D FIND^DIC(748.31,","_NLPART_",",.01,"X",NURNUM,"","B") S NURQUES="" I +$G(^TMP("DILIST",$J,0)) S NURQUES=$G(^TMP("DILIST",$J,2,1)) K ^TMP("DILIST",$J)
- ..S NANS="" F S NANS=$O(^TMP($J,NURQUES,NANS)) Q:NANS=""!$G(NUROUT) S NDTA=$G(^TMP($J,NURQUES,NANS)) Q:NDTA="" S NURANS=$P(NDTA,U,1),NSTEXT=$P(^TMP($J,NURQUES,NANS),U,2) DO
- ...;reduce participants by # of skipped or n/a questions
- ...S NBLNKS=0 I NBYPASS=2,NANS'=" " S NBLNKS=+$P($G(^TMP($J,NURQUES," ")),U,1),NURTPRT=NURTPRT-NBLNKS
- ...S NBLNKNA=0 I NPASSNA=2,NANS'="NA" S NBLNKNA=+$P($G(^TMP($J,NURQUES,"NA")),U,1),NURTPRT=NURTPRT-NBLNKNA
- ...I NANS="WP" S NURQUES1=$P(NDTA,U,2) D WP^NURQUTL2 Q
- ...I NSTEXT]"","^ ^T^F^Y^N^NA^"[NANS S NSTEXT=$S(NANS="NA":"Not applicable",NANS="T":"True",NANS="F":"False",NANS="Y":"Yes",NANS="N":"No",NANS=" ":"did not respond",1:"???")
- ...S NPCNT=0 I NURTPRT>0 S NPCNT=$J((NURANS/NURTPRT)*100,4,1)
- ...S NRESPD=" participant"_$S(NURANS=1:"",1:"s")
- ...D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W !,?9,NURANS,NRESPD_" "," or "_NPCNT_"% ",$S(NANS'=" ":"responded ",1:""),NSTEXT
- ...S NURTPRT=NURTPRT+NBLNKS ;add back skipped questions
- ...S NURTPRT=NURTPRT+NBLNKNA ;add back NA questions
- W:'$G(NUROUT) !,?3,"Total responses: ",NURTPRT,!
- EXIT ;
- K NANS,NBLNKNA,NBLNKS,NDISP,NDTA,NGRDIENT,NLPART,NPART,NPART1,NPCNT,NPQUES,NQY,NQZ,NRESPD,NSTEXT,NSTYPE,NURANS,NURNUM,NURQUES,NURQUES1,NURSITE,NURTPRT,^TMP($J),NBYPASS,NPASSNA,NLFTLBL,NRGTLBL,NARRAY
- K ^TMP("DILIST",$J),^TMP("NURQ1",$J),^TMP("NURQ2",$J),^TMP("NURQ3",$J)
- W:'$G(NUROUT) ?3,"----------",! Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURQUTL3 4511 printed Feb 18, 2025@23:47:42 Page 2
- NURQUTL3 ;HIRMFO/RM,YH-SURVEY STATISTICS PART 1 ;4/22/96
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- PRINT ;
- +1 KILL ^TMP($JOB)
- SET (NURTPRT,NURANS)=0
- SET (NBYPASS,NPASSNA)=1
- +2 SET NURSITE=$PIECE($$SITE^VASITE,"^",2)
- +3 KILL ^TMP("DILIST",$JOB),^TMP("NURQ1",$JOB)
- DO FIND^DIC(748.3,"",".01;3","MX",$$GET1^DIQ(748,NURQSVN,.01,"E"),"","B","I $$GET1^DIQ(748.3,+Y,.01,""I"")=NURQSVN")
- +4 SET NURQI=0
- FOR
- SET NURQI=$ORDER(^TMP("DILIST",$JOB,2,NURQI))
- if NURQI'>0
- QUIT
- SET NPART=$GET(^TMP("DILIST",$JOB,2,NURQI))
- if NPART=""
- QUIT
- Begin DoDot:1
- +5 ;only completed responses
- if $GET(^TMP("DILIST",$JOB,"ID",NURQI,3))'="COMPLETED"
- QUIT
- +6 SET NLPART=NPART
- KILL ^TMP("NURQ1",$JOB)
- DO GETS^DIQ(748.3,NPART_",","**","","^TMP(""NURQ1"",$J)")
- if NURQWRD>0&(NURQWRD'=$PIECE($GET(^TMP("NURQ1",$JOB,748.36,"1,"_NPART_",",1)),"^"))
- QUIT
- +7 SET NURQJ=""
- FOR
- SET NURQJ=$ORDER(^TMP("NURQ1",$JOB,748.31,NURQJ))
- if NURQJ=""
- QUIT
- SET NURNUM=$PIECE(NURQJ,",")
- IF NURNUM>0
- SET NANS=$GET(^TMP("NURQ1",$JOB,748.31,NURQJ,1))
- Begin DoDot:2
- +8 ;aborted WP response
- IF NANS=""
- IF $GET(^TMP("NURQ1",$JOB,748.31,NURQJ,2))=""
- QUIT
- +9 IF NANS=""
- IF $GET(^TMP("NURQ1",$JOB,748.31,NURQJ,2))]""
- SET ^TMP($JOB,NURNUM,"WP")="WP"_U_NURNUM
- QUIT
- +10 ;NPQUES is the question pointer
- IF NANS]""
- if '$DATA(^TMP($JOB,NURNUM,NANS))
- SET ^TMP($JOB,NURNUM,NANS)="0^"
- SET $PIECE(^TMP($JOB,NURNUM,NANS),U,1)=$PIECE(^TMP($JOB,NURNUM,NANS),U,1)+1
- SET NPQUES=$GET(^TMP("NURQ1",$JOB,748.31,NURQJ,.01))
- +11 IF +NANS>0
- SET %=$$GET1^DIQ(748.28,NANS_","_NPQUES_","_NURQSVN_",",.01)
- SET $PIECE(^TMP($JOB,NURNUM,NANS),U,2)=$SELECT(%]"":%,1:NANS)
- +12 IF +NANS=0
- SET %=$$GET1^DIQ(748.28,($ASCII(NANS)-96)_","_NPQUES_","_NURQSVN_",",.01)
- SET $PIECE(^TMP($JOB,NURNUM,NANS),U,2)=$SELECT(%]"":%,1:NANS)
- +13 QUIT
- End DoDot:2
- +14 SET NURTPRT=NURTPRT+1
- SET ^TMP($JOB,"QAPZ",NPART)=""
- +15 QUIT
- End DoDot:1
- +16 ;NLPART is the ifn of the last participant examined. It is kept
- +17 ;as a link to file 748.3
- +18 IF NURTPRT=0
- if ($Y>(IOSL-7))
- DO HDR^NURQRPT0
- if NUROUT
- GOTO EXIT
- WRITE !!?10,"No one has yet participated in this survey.",!
- GOTO EXIT
- +19 ;print the question
- +20 KILL ^TMP("DILIST",$JOB),^TMP("NURQ2",$JOB)
- +21 DO LIST^DIC(748.26,","_NURQSVN_",",".015")
- +22 SET NURQI=0
- FOR
- SET NURQI=$ORDER(^TMP("DILIST",$JOB,"ID",NURQI))
- if NURQI'>0!$GET(NUROUT)
- QUIT
- SET NDISP=$GET(^TMP("DILIST",$JOB,"ID",NURQI,.015))
- SET NURNUM=$GET(^TMP("DILIST",$JOB,2,NURQI))
- IF NDISP>0
- IF NURNUM>0
- SET ^TMP("NURQ2",$JOB,NURQSVN,NDISP,NURNUM)=""
- +23 FOR NDISP=0:0
- SET NDISP=$ORDER(^TMP("NURQ2",$JOB,NURQSVN,NDISP))
- if NDISP=""!$GET(NUROUT)
- QUIT
- FOR NURNUM=0:0
- SET NURNUM=$ORDER(^TMP("NURQ2",$JOB,NURQSVN,NDISP,NURNUM))
- if NURNUM'>0!$GET(NUROUT)
- QUIT
- Begin DoDot:1
- +24 if ($Y>(IOSL-7))
- DO HDR^NURQRPT0
- if $GET(NUROUT)
- QUIT
- +25 ;NDISP=QUESTION ORDER NUMBER, NURNUM=QUESTION NUMBER
- KILL ^TMP("NURQ3",$JOB)
- DO GETS^DIQ(748.26,NURNUM_","_NURQSVN_",","**","","^TMP(""NURQ3"",$J)")
- +26 WRITE !,NDISP,") "
- FOR I=0:0
- SET I=$ORDER(^TMP("NURQ3",$JOB,748.26,NURNUM_","_NURQSVN_",",.05,I))
- if I=""!(+I=0)
- Begin DoDot:2
- +27 SET NSTYPE=$GET(^TMP("NURQ3",$JOB,748.26,NURNUM_","_NURQSVN_",",.025))
- SET NGRDIENT=$GET(^(0.027))
- IF NSTYPE="LIKERT SCALE"
- SET NURQUES=NURNUM
- DO LIKRTLAB^NURQUTL2
- KILL NURQUES
- +28 ;;FINDS THE IEN FOR A QUESTION NUMBER IN THE SURVEY RESPONSE DATA #748.3 FILE
- +29 ;;SET NURQUES = IEN
- +30 KILL ^TMP("DILIST",$JOB)
- DO FIND^DIC(748.31,","_NLPART_",",.01,"X",NURNUM,"","B")
- SET NURQUES=""
- IF +$GET(^TMP("DILIST",$JOB,0))
- SET NURQUES=$GET(^TMP("DILIST",$JOB,2,1))
- KILL ^TMP("DILIST",$JOB)
- +31 SET NANS=""
- FOR
- SET NANS=$ORDER(^TMP($JOB,NURQUES,NANS))
- if NANS=""!$GET(NUROUT)
- QUIT
- SET NDTA=$GET(^TMP($JOB,NURQUES,NANS))
- if NDTA=""
- QUIT
- SET NURANS=$PIECE(NDTA,U,1)
- SET NSTEXT=$PIECE(^TMP($JOB,NURQUES,NANS),U,2)
- Begin DoDot:3
- +32 ;reduce participants by # of skipped or n/a questions
- +33 SET NBLNKS=0
- IF NBYPASS=2
- IF NANS'=" "
- SET NBLNKS=+$PIECE($GET(^TMP($JOB,NURQUES," ")),U,1)
- SET NURTPRT=NURTPRT-NBLNKS
- +34 SET NBLNKNA=0
- IF NPASSNA=2
- IF NANS'="NA"
- SET NBLNKNA=+$PIECE($GET(^TMP($JOB,NURQUES,"NA")),U,1)
- SET NURTPRT=NURTPRT-NBLNKNA
- +35 IF NANS="WP"
- SET NURQUES1=$PIECE(NDTA,U,2)
- DO WP^NURQUTL2
- QUIT
- +36 IF NSTEXT]""
- IF "^ ^T^F^Y^N^NA^"[NANS
- SET NSTEXT=$SELECT(NANS="NA":"Not applicable",NANS="T":"True",NANS="F":"False",NANS="Y":"Yes",NANS="N":"No",NANS=" ":"did not respond",1:"???")
- +37 SET NPCNT=0
- IF NURTPRT>0
- SET NPCNT=$JUSTIFY((NURANS/NURTPRT)*100,4,1)
- +38 SET NRESPD=" participant"_$SELECT(NURANS=1:"",1:"s")
- +39 if ($Y>(IOSL-7))
- DO HDR^NURQRPT0
- if $GET(NUROUT)
- QUIT
- WRITE !,?9,NURANS,NRESPD_" "," or "_NPCNT_"% ",$SELECT(NANS'=" ":"responded ",1:""),NSTEXT
- +40 ;add back skipped questions
- SET NURTPRT=NURTPRT+NBLNKS
- +41 ;add back NA questions
- SET NURTPRT=NURTPRT+NBLNKNA
- End DoDot:3
- End DoDot:2
- if I=""!(+I=0)!$GET(NUROUT)
- QUIT
- SET X=$GET(^TMP("NURQ3",$JOB,748.26,NURNUM_","_NURQSVN_",",.05,I))
- WRITE X,!
- End DoDot:1
- WRITE !
- +42 if '$GET(NUROUT)
- WRITE !,?3,"Total responses: ",NURTPRT,!
- EXIT ;
- +1 KILL NANS,NBLNKNA,NBLNKS,NDISP,NDTA,NGRDIENT,NLPART,NPART,NPART1,NPCNT,NPQUES,NQY,NQZ,NRESPD,NSTEXT,NSTYPE,NURANS,NURNUM,NURQUES,NURQUES1,NURSITE,NURTPRT,^TMP($JOB),NBYPASS,NPASSNA,NLFTLBL,NRGTLBL,NARRAY
- +2 KILL ^TMP("DILIST",$JOB),^TMP("NURQ1",$JOB),^TMP("NURQ2",$JOB),^TMP("NURQ3",$JOB)
- +3 if '$GET(NUROUT)
- WRITE ?3,"----------",!
- QUIT