QAPXFER.m

QAPXFER ;557/THM-EXPORT A SURVEY [ 06/22/95  2:25 PM ]

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

 ;

 S IOP="HOME" D ^%ZIS,SCREEN^QAPUTIL S QAPHDR="Export a Survey"

ENTR W @IOF,! X QAPBAR

 S DIC("S")="I $P(^(0),U,5)=DUZ!($D(^XUSEC(""QAP MANAGER"",DUZ)))!($D(^QA(748,""AB"",DUZ,+Y)))"

 W !! S DIC="^QA(748,",DIC(0)="QEAM",DIC("A")="Enter the survey to export: " D ^DIC G:X=""!(X[U) K S SURVEY=+Y

 W !!,"Is this the correct survey" S %=2 D YN^DICN G:$D(DTOUT) K

 I $D(%Y),%Y["?" W !!,"Enter Y if it is the correct survey or N if not.  " H 2 G ENTR

 I %<1 G K

 I %=2 G ENTR

 ;

XFR K DIC,%,^TMP($J,"QAP")

 S SVYNAME=$P(^QA(748,SURVEY,0),U),SVYSITE=^DD("SITE")

 S %X="^QA(748,"_SURVEY_",",%Y="^TMP($J,""QAP"",999998," D %XY^%RCR

 S %X="^QA(748.25,"_SURVEY_",",%Y="^TMP($J,""QAP"",999999," D %XY^%RCR

 S ^TMP($J,"QAP",.5)=SVYNAME_U_SVYSITE

 S XMSUB="Import of Survey: "_SVYNAME,XMTEXT="^TMP($J,""QAP""," W !! S XMMG=$P(^VA(200,DUZ,0),U)

 ;all calls are supported APIs

 D XMZ^XMA2 W !!,"Loading survey . . .  " H 1 D ENT^XMPG

 S XMDUZ=DUZ,XMDUN=$P(^VA(200,DUZ,0),U) D DEST^XMA21

 D ENT1^XMD

 W !!,"Sent as message #",XMZ,!!!,"Press RETURN  " R ANS:DTIME

 K XMDUZ,XMDUN,XMY,XMZ,XMMG,XMSUB,XMTEXT,XCN,XMA,XMAP0R,XMDISPI,XMGAPI1,XMQF,XMXUSEC,ER

 ;

K G EXIT^QAPUTIL

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAPXFER   1276     printed  Apr 09, 2024@21:40:41                                                                                                                                                                                                     Page 2

QAPXFER   ;557/THM-EXPORT A SURVEY [ 06/22/95  2:25 PM ]

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

 +2       ;

 +3        SET IOP="HOME"

           DO ^%ZIS

           DO SCREEN^QAPUTIL

           SET QAPHDR="Export a Survey"

ENTR       WRITE @IOF,!

           XECUTE QAPBAR

 +1        SET DIC("S")="I $P(^(0),U,5)=DUZ!($D(^XUSEC(""QAP MANAGER"",DUZ)))!($D(^QA(748,""AB"",DUZ,+Y)))"

 +2        WRITE !!

           SET DIC="^QA(748,"

           SET DIC(0)="QEAM"

           SET DIC("A")="Enter the survey to export: "

           DO ^DIC

           if X=""!(X[U)

               GOTO K

           SET SURVEY=+Y

 +3        WRITE !!,"Is this the correct survey"

           SET %=2

           DO YN^DICN

           if $DATA(DTOUT)

               GOTO K

 +4        IF $DATA(%Y)

               IF %Y["?"

                   WRITE !!,"Enter Y if it is the correct survey or N if not.  "

                   HANG 2

                   GOTO ENTR

 +5        IF %<1

               GOTO K

 +6        IF %=2

               GOTO ENTR

 +7       ;

XFR        KILL DIC,%,^TMP($JOB,"QAP")

 +1        SET SVYNAME=$PIECE(^QA(748,SURVEY,0),U)

           SET SVYSITE=^DD("SITE")

 +2        SET %X="^QA(748,"_SURVEY_","

           SET %Y="^TMP($J,""QAP"",999998,"

           DO %XY^%RCR

 +3        SET %X="^QA(748.25,"_SURVEY_","

           SET %Y="^TMP($J,""QAP"",999999,"

           DO %XY^%RCR

 +4        SET ^TMP($JOB,"QAP",.5)=SVYNAME_U_SVYSITE

 +5        SET XMSUB="Import of Survey: "_SVYNAME

           SET XMTEXT="^TMP($J,""QAP"","

           WRITE !!

           SET XMMG=$PIECE(^VA(200,DUZ,0),U)

 +6       ;all calls are supported APIs

 +7        DO XMZ^XMA2

           WRITE !!,"Loading survey . . .  "

           HANG 1

           DO ENT^XMPG

 +8        SET XMDUZ=DUZ

           SET XMDUN=$PIECE(^VA(200,DUZ,0),U)

           DO DEST^XMA21

 +9        DO ENT1^XMD

 +10       WRITE !!,"Sent as message #",XMZ,!!!,"Press RETURN  "

           READ ANS:DTIME

 +11       KILL XMDUZ,XMDUN,XMY,XMZ,XMMG,XMSUB,XMTEXT,XCN,XMA,XMAP0R,XMDISPI,XMGAPI1,XMQF,XMXUSEC,ER

 +12      ;

K          GOTO EXIT^QAPUTIL