QAPDCK.m

QAPDCK ;557/THM-INPUT TRANSFORM CHECKS [ 03/04/95  6:53 AM ]

 ;;2.0;Survey Generator;;Jun 20, 1995

 ;

EN1 ;field .015 in 748.26

 ;see if question number exists

 N %X,%Y,CURNUM S SURVEY=$S($D(SURVEY):SURVEY,1:DA(1))

 S CURNUM=$P($G(^QA(748.25,SURVEY,1,DA,0)),U,2) Q:+CURNUM=X  ;no change

 I $D(^QA(748.25,"E",SURVEY,X)) W !!,*7,"That number already exists.",! H 1 K X Q

 ;verifiy the change of question number

 I CURNUM]"",CURNUM'=X DO

 .W *7,!!,"You are about the change the number of this question.",!,"Is that what you want to do",*7 S %=2 D YN^DICN I %'=1 K X

 .W !!

 .K %,%Y,CURNUM

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAPDCK   603     printed  Apr 09, 2024@21:40:38                                                                                                                                                                                                       Page 2

QAPDCK    ;557/THM-INPUT TRANSFORM CHECKS [ 03/04/95  6:53 AM ]

 +1       ;;2.0;Survey Generator;;Jun 20, 1995

 +2       ;

EN1       ;field .015 in 748.26

 +1       ;see if question number exists

 +2        NEW %X,%Y,CURNUM

           SET SURVEY=$SELECT($DATA(SURVEY):SURVEY,1:DA(1))

 +3       ;no change

           SET CURNUM=$PIECE($GET(^QA(748.25,SURVEY,1,DA,0)),U,2)

           if +CURNUM=X

               QUIT 

 +4        IF $DATA(^QA(748.25,"E",SURVEY,X))

               WRITE !!,*7,"That number already exists.",!

               HANG 1

               KILL X

               QUIT 

 +5       ;verifiy the change of question number

 +6        IF CURNUM]""

               IF CURNUM'=X

                   Begin DoDot:1

 +7                    WRITE *7,!!,"You are about the change the number of this question.",!,"Is that what you want to do",*7

                       SET %=2

                       DO YN^DICN

                       IF %'=1

                           KILL X

 +8                    WRITE !!

 +9                    KILL %,%Y,CURNUM

                   End DoDot:1

 +10       QUIT