QAPRELS.m

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 ---QAPRELS   1034     printed  Apr 09, 2024@21:40:48                                                                                                                                                                                                     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