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 ---[H[J[2J[HQAPDCK 603 printed Nov 22, 2024@17:48:08 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
