- 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 Mar 13, 2025@21:43:43 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
