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 ---[H[J[2J[HQAPXFER 1276 printed Dec 13, 2024@02:38:40 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
