QAP2P08 ; ALB/MJB - SET QAP OPTIONS OUT OF ORDER ;
;;2.0;SURVEY GENERATOR;**8**;Jun 20, 1995;Build 9
;Reference to XPDMENU supported by ICR 1157
Q
;
MAIN(QAP) ; Step through options, pull IEN from B index and update
;QAP IS THE MENU RESTORE FLAG : 1=restore, anything else will place out of order
N DA,DIE,DR,DO,QAPSOPT,QAPSD0,QAPMSG,QAPI,QAPTXT K X,Y
S QAP=$G(QAP),QAPTXT=$S(QAP=1:"@",1:"Option has been placed out of order")
F QAPI=1:1 S QAPSOPT=$P($T(OPTS+QAPI^QAP2P08),";",3) Q:QAPSOPT="" D
. S QAPSD0=$O(^DIC(19,"B",QAPSOPT,0)) I QAPSD0="" S QAPMSG="OPTION "_QAPSOPT_" NOT FOUND" D EN^DDIOL(QAPMSG) Q
. Q:$P($G(^DIC(19,QAPSD0,0)),"^")'=QAPSOPT
. S QAPMSG="SETTING "_QAPSOPT_" TO "_$S(QAP=1:"ACTIVE...",1:"OUT OF ORDER...")
. D EN^DDIOL(QAPMSG),OUT^XPDMENU(QAPSOPT,QAPTXT)
.Q
D CLEAN^DILF
Q
OPTS ; Options to disable
;;QAP CLEAR SURVEY
;;QAP COPY SURVEY
;;QAP COUNT SURVEY PARTICIPANTS
;;QAP DELETE SURVEY
;;QAP DEMOGRAPHIC PRINT
;;QAP EDIT INCOMPLETE SURVEY
;;QAP EXPORT A SURVEY
;;QAP FIX RESPONSE
;;QAP GENERATE SURVEY STATISTICS
;;QAP IMPORT A SURVEY
;;QAP PARTICIPANT MENU
;;QAP PARTICIPATE
;;QAP POPULATE DEMOGRAPHIC FILE
;;QAP PRINT A SURVEY
;;QAP PRINT ALL INDIV RESPONSES
;;QAP RELEASE/DISABLE A SURVEY
;;QAP SURVEY MAINTENANCE
;;QAP USER PRINT HARDCOPY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAP2P08 1342 printed Dec 13, 2024@02:38:05 Page 2
QAP2P08 ; ALB/MJB - SET QAP OPTIONS OUT OF ORDER ;
+1 ;;2.0;SURVEY GENERATOR;**8**;Jun 20, 1995;Build 9
+2 ;Reference to XPDMENU supported by ICR 1157
+3 QUIT
+4 ;
MAIN(QAP) ; Step through options, pull IEN from B index and update
+1 ;QAP IS THE MENU RESTORE FLAG : 1=restore, anything else will place out of order
+2 NEW DA,DIE,DR,DO,QAPSOPT,QAPSD0,QAPMSG,QAPI,QAPTXT
KILL X,Y
+3 SET QAP=$GET(QAP)
SET QAPTXT=$SELECT(QAP=1:"@",1:"Option has been placed out of order")
+4 FOR QAPI=1:1
SET QAPSOPT=$PIECE($TEXT(OPTS+QAPI^QAP2P08),";",3)
if QAPSOPT=""
QUIT
Begin DoDot:1
+5 SET QAPSD0=$ORDER(^DIC(19,"B",QAPSOPT,0))
IF QAPSD0=""
SET QAPMSG="OPTION "_QAPSOPT_" NOT FOUND"
DO EN^DDIOL(QAPMSG)
QUIT
+6 if $PIECE($GET(^DIC(19,QAPSD0,0)),"^")'=QAPSOPT
QUIT
+7 SET QAPMSG="SETTING "_QAPSOPT_" TO "_$SELECT(QAP=1:"ACTIVE...",1:"OUT OF ORDER...")
+8 DO EN^DDIOL(QAPMSG)
DO OUT^XPDMENU(QAPSOPT,QAPTXT)
+9 QUIT
End DoDot:1
+10 DO CLEAN^DILF
+11 QUIT
OPTS ; Options to disable
+1 ;;QAP CLEAR SURVEY
+2 ;;QAP COPY SURVEY
+3 ;;QAP COUNT SURVEY PARTICIPANTS
+4 ;;QAP DELETE SURVEY
+5 ;;QAP DEMOGRAPHIC PRINT
+6 ;;QAP EDIT INCOMPLETE SURVEY
+7 ;;QAP EXPORT A SURVEY
+8 ;;QAP FIX RESPONSE
+9 ;;QAP GENERATE SURVEY STATISTICS
+10 ;;QAP IMPORT A SURVEY
+11 ;;QAP PARTICIPANT MENU
+12 ;;QAP PARTICIPATE
+13 ;;QAP POPULATE DEMOGRAPHIC FILE
+14 ;;QAP PRINT A SURVEY
+15 ;;QAP PRINT ALL INDIV RESPONSES
+16 ;;QAP RELEASE/DISABLE A SURVEY
+17 ;;QAP SURVEY MAINTENANCE
+18 ;;QAP USER PRINT HARDCOPY
+19 QUIT
