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