QAPRELS ;557/THM-CHANGE A SURVEY STATUS [ 05/25/95 9:02 AM ]
;;2.0;Survey Generator;;Jun 20, 1995
;
D SCREEN^QAPUTIL
EN W @IOF,! S QAPHDR="Release/Disable a Survey for Participation" X QAPBAR W !?49,BLDON,"Type RETURN or '^' to exit",BLDOFF,!!
K DIC,DIE,DR S DIC="^QA(748,",DIC(0)="AEQMZ",DIC("A")="Select a survey: " D ^DIC G:X=""!(X[U) EXIT S DA=+Y
S LASTDATE=$P(Y(0),U,3)
I LASTDATE]"",DT>LASTDATE W !!,*7,"The LAST DATE FOR USAGE is earlier than today's date.",!,"You must change it to a future date before you may release",!,"this survey.",!!,"Press RETURN " R ANS:DTIME G:'$T EXIT G EN
S X=$P(^QA(748,DA,0),U,4),CURSTAT=$S(X="r":"READY FOR USE",X="e":"ACTIVE LIFE EXPIRED",1:"UNDER DEVELOPMENT/MAINTENANCE")
W !!,"Current status is ",CURSTAT,!! S QLINE=$Y
K DIR S DIR(0)="S^r:Ready for use;d:Under development/maintenance;e:Active life expired" D ^DIR G:$D(DTOUT) EXIT I $D(DIRUT) G EN
I Y="r" D ^QAPCHKST I '$D(X)#2 G EN
S X=Y,DIE=DIC,DIC(0)="M",DR=".05///"_X
D ^DIE
G EN
;
EXIT G EXIT^QAPUTIL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPRELS 1034 printed Nov 22, 2024@17:48:26 Page 2
QAPRELS ;557/THM-CHANGE A SURVEY STATUS [ 05/25/95 9:02 AM ]
+1 ;;2.0;Survey Generator;;Jun 20, 1995
+2 ;
+3 DO SCREEN^QAPUTIL
EN WRITE @IOF,!
SET QAPHDR="Release/Disable a Survey for Participation"
XECUTE QAPBAR
WRITE !?49,BLDON,"Type RETURN or '^' to exit",BLDOFF,!!
+1 KILL DIC,DIE,DR
SET DIC="^QA(748,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select a survey: "
DO ^DIC
if X=""!(X[U)
GOTO EXIT
SET DA=+Y
+2 SET LASTDATE=$PIECE(Y(0),U,3)
+3 IF LASTDATE]""
IF DT>LASTDATE
WRITE !!,*7,"The LAST DATE FOR USAGE is earlier than today's date.",!,"You must change it to a future date before you may release",!,"this survey.",!!,"Press RETURN "
READ ANS:DTIME
if '$TEST
GOTO EXIT
GOTO EN
+4 SET X=$PIECE(^QA(748,DA,0),U,4)
SET CURSTAT=$SELECT(X="r":"READY FOR USE",X="e":"ACTIVE LIFE EXPIRED",1:"UNDER DEVELOPMENT/MAINTENANCE")
+5 WRITE !!,"Current status is ",CURSTAT,!!
SET QLINE=$Y
+6 KILL DIR
SET DIR(0)="S^r:Ready for use;d:Under development/maintenance;e:Active life expired"
DO ^DIR
if $DATA(DTOUT)
GOTO EXIT
IF $DATA(DIRUT)
GOTO EN
+7 IF Y="r"
DO ^QAPCHKST
IF '$DATA(X)#2
GOTO EN
+8 SET X=Y
SET DIE=DIC
SET DIC(0)="M"
SET DR=".05///"_X
+9 DO ^DIE
+10 GOTO EN
+11 ;
EXIT GOTO EXIT^QAPUTIL
