| 1 | QAPXFER ;557/THM-EXPORT A SURVEY [ 06/22/95 2:25 PM ]
|
|---|
| 2 | ;;2.0;Survey Generator;;Jun 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | S IOP="HOME" D ^%ZIS,SCREEN^QAPUTIL S QAPHDR="Export a Survey"
|
|---|
| 5 | ENTR W @IOF,! X QAPBAR
|
|---|
| 6 | S DIC("S")="I $P(^(0),U,5)=DUZ!($D(^XUSEC(""QAP MANAGER"",DUZ)))!($D(^QA(748,""AB"",DUZ,+Y)))"
|
|---|
| 7 | 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
|
|---|
| 8 | W !!,"Is this the correct survey" S %=2 D YN^DICN G:$D(DTOUT) K
|
|---|
| 9 | I $D(%Y),%Y["?" W !!,"Enter Y if it is the correct survey or N if not. " H 2 G ENTR
|
|---|
| 10 | I %<1 G K
|
|---|
| 11 | I %=2 G ENTR
|
|---|
| 12 | ;
|
|---|
| 13 | XFR K DIC,%,^TMP($J,"QAP")
|
|---|
| 14 | S SVYNAME=$P(^QA(748,SURVEY,0),U),SVYSITE=^DD("SITE")
|
|---|
| 15 | S %X="^QA(748,"_SURVEY_",",%Y="^TMP($J,""QAP"",999998," D %XY^%RCR
|
|---|
| 16 | S %X="^QA(748.25,"_SURVEY_",",%Y="^TMP($J,""QAP"",999999," D %XY^%RCR
|
|---|
| 17 | S ^TMP($J,"QAP",.5)=SVYNAME_U_SVYSITE
|
|---|
| 18 | S XMSUB="Import of Survey: "_SVYNAME,XMTEXT="^TMP($J,""QAP""," W !! S XMMG=$P(^VA(200,DUZ,0),U)
|
|---|
| 19 | ;all calls are supported APIs
|
|---|
| 20 | D XMZ^XMA2 W !!,"Loading survey . . . " H 1 D ENT^XMPG
|
|---|
| 21 | S XMDUZ=DUZ,XMDUN=$P(^VA(200,DUZ,0),U) D DEST^XMA21
|
|---|
| 22 | D ENT1^XMD
|
|---|
| 23 | W !!,"Sent as message #",XMZ,!!!,"Press RETURN " R ANS:DTIME
|
|---|
| 24 | K XMDUZ,XMDUN,XMY,XMZ,XMMG,XMSUB,XMTEXT,XCN,XMA,XMAP0R,XMDISPI,XMGAPI1,XMQF,XMXUSEC,ER
|
|---|
| 25 | ;
|
|---|
| 26 | K G EXIT^QAPUTIL
|
|---|
