QAQAHOCZ ;HISC/DAD-AD HOC REPORTS: INTERFACE COMPILER ;9/3/91 15:52 [ 10/07/92 7:10 PM ]
;;1.7;QM Integration Module;;07/25/1995
;
D EXIT,HOME^%ZIS S QAQYESNO="Please answer Y(es) or N(o)."
D NOW^%DTC S X=$J(%,0,6),QAQTODAY=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_" "_$E(X,9,10)_":"_$E(X,11,12)
ROUTINE ; *** Prompt user for Ad Hoc interface routine name
K DIR S DIR(0)="FAO^2:8^K:X'?1U1.7UN X",DIR("A")="Ad Hoc Report Generator Interface Routine: ",DIR("?")="^D EN^QAQAHOCH(""H6"")"
W ! D ^DIR G:$D(DIRUT) EXIT S (QAQPROG,X)=Y
X ^%ZOSF("TEST") I D G EXIT:QAQREPLC=-1,ROUTINE:QAQREPLC=2
. W !!?5,"*** ",QAQPROG," already exists !! ***",*7
R1 . W !!?5,"Do you want to replace it"
. S %=2 D YN^DICN S QAQREPLC=%
. Q:(%=-1)!(%=2) I '% W !!?10,QAQYESNO G R1
R2 . W !!?5,"Replace ",QAQPROG,", are you sure"
. S %=2 D YN^DICN S QAQREPLC=%
. Q:%=-1 I '% W !!?10,QAQYESNO G R2
. Q
FILE ; *** Prompt user for the file that Ad Hoc will use
W !!,"Select the FILE to be used by the Ad Hoc Report Generator."
K DIC S DIC="^DIC(",DIC(0)="AEMNQZ",DIC("A")="Select FILE: " D ^DIC G:Y'>0 EXIT S QAQFILE=+Y,QAQFILE(0)=Y(0,0)
FIELDS ; *** Prompt user for the fields that Ad Hoc will use
W !!,"Select the FIELDS to be used by the Ad Hoc Report Generator."
D ^QAQAHOCY G:QAQMMAX'>0!QAQQUIT EXIT I QAQSORT'>0 W !!?5,"*** No sort fields chosen !! ***",*7 G EXIT
NODATA ; *** Include optional output checking code in OTHER entry point (Y/N)
W !!,"Automatically include the ""No data found..."" message" S %=1 D YN^DICN G:%=-1 EXIT S QAQNODAT=$S(%=1:1,1:0)
I '% D EN^QAQAHOCH("H8") G NODATA
K DIR S DIR(0)="FAO^0:45^K:(X[""^"")!(X[$C(34)) X",DIR("A")="Menu screen header: ",DIR("?")="^D EN^QAQAHOCH(""H9"")"
W ! D ^DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) EXIT S QAQMHDR=Y
BUILD ; *** Build Ad Hoc Report interface routine(s)
W !!,"Building the Ad Hoc Report Generator interface routine(s)...",!
D BUILD^QAQAHOCX
W !!,"Enter 'DO ^",QAQPROG,"' to run the Ad Hoc Report Generator."
EXIT ; *** Exit the Ad Hoc interface compiler
K %,%DT,%H,DIC,DIE,DIR,DIRUT,DTOUT,DUOUT
K ^TMP($J,"QAQTXT"),^TMP($J,"QAQROU")
K QA,QAI,QAQ,QAQCHOSN,QAQDD,QAQDONE,QAQFILE,QAQLEN,QAQLEVEL,QAQLN,QAQMHDR,QAQMMAX,QAQNODAT,QAQPROG,QAQQUIT,QAQREPLC,QAQRTN,QAQRTNNO,QAQRTNXT,QAQSORT,QAQTAB,QAQTEXT,QAQTODAY,QAQWP,QAQYESNO,X,XCM,XCN,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAQAHOCZ 2413 printed Dec 13, 2024@02:31:18 Page 2
QAQAHOCZ ;HISC/DAD-AD HOC REPORTS: INTERFACE COMPILER ;9/3/91 15:52 [ 10/07/92 7:10 PM ]
+1 ;;1.7;QM Integration Module;;07/25/1995
+2 ;
+3 DO EXIT
DO HOME^%ZIS
SET QAQYESNO="Please answer Y(es) or N(o)."
+4 DO NOW^%DTC
SET X=$JUSTIFY(%,0,6)
SET QAQTODAY=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)_" "_$EXTRACT(X,9,10)_":"_$EXTRACT(X,11,12)
ROUTINE ; *** Prompt user for Ad Hoc interface routine name
+1 KILL DIR
SET DIR(0)="FAO^2:8^K:X'?1U1.7UN X"
SET DIR("A")="Ad Hoc Report Generator Interface Routine: "
SET DIR("?")="^D EN^QAQAHOCH(""H6"")"
+2 WRITE !
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
SET (QAQPROG,X)=Y
+3 XECUTE ^%ZOSF("TEST")
IF $TEST
Begin DoDot:1
+4 WRITE !!?5,"*** ",QAQPROG," already exists !! ***",*7
R1 WRITE !!?5,"Do you want to replace it"
+1 SET %=2
DO YN^DICN
SET QAQREPLC=%
+2 if (%=-1)!(%=2)
QUIT
IF '%
WRITE !!?10,QAQYESNO
GOTO R1
R2 WRITE !!?5,"Replace ",QAQPROG,", are you sure"
+1 SET %=2
DO YN^DICN
SET QAQREPLC=%
+2 if %=-1
QUIT
IF '%
WRITE !!?10,QAQYESNO
GOTO R2
+3 QUIT
End DoDot:1
if QAQREPLC=-1
GOTO EXIT
if QAQREPLC=2
GOTO ROUTINE
FILE ; *** Prompt user for the file that Ad Hoc will use
+1 WRITE !!,"Select the FILE to be used by the Ad Hoc Report Generator."
+2 KILL DIC
SET DIC="^DIC("
SET DIC(0)="AEMNQZ"
SET DIC("A")="Select FILE: "
DO ^DIC
if Y'>0
GOTO EXIT
SET QAQFILE=+Y
SET QAQFILE(0)=Y(0,0)
FIELDS ; *** Prompt user for the fields that Ad Hoc will use
+1 WRITE !!,"Select the FIELDS to be used by the Ad Hoc Report Generator."
+2 DO ^QAQAHOCY
if QAQMMAX'>0!QAQQUIT
GOTO EXIT
IF QAQSORT'>0
WRITE !!?5,"*** No sort fields chosen !! ***",*7
GOTO EXIT
NODATA ; *** Include optional output checking code in OTHER entry point (Y/N)
+1 WRITE !!,"Automatically include the ""No data found..."" message"
SET %=1
DO YN^DICN
if %=-1
GOTO EXIT
SET QAQNODAT=$SELECT(%=1:1,1:0)
+2 IF '%
DO EN^QAQAHOCH("H8")
GOTO NODATA
+1 KILL DIR
SET DIR(0)="FAO^0:45^K:(X[""^"")!(X[$C(34)) X"
SET DIR("A")="Menu screen header: "
SET DIR("?")="^D EN^QAQAHOCH(""H9"")"
+2 WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO EXIT
SET QAQMHDR=Y
BUILD ; *** Build Ad Hoc Report interface routine(s)
+1 WRITE !!,"Building the Ad Hoc Report Generator interface routine(s)...",!
+2 DO BUILD^QAQAHOCX
+3 WRITE !!,"Enter 'DO ^",QAQPROG,"' to run the Ad Hoc Report Generator."
EXIT ; *** Exit the Ad Hoc interface compiler
+1 KILL %,%DT,%H,DIC,DIE,DIR,DIRUT,DTOUT,DUOUT
+2 KILL ^TMP($JOB,"QAQTXT"),^TMP($JOB,"QAQROU")
+3 KILL QA,QAI,QAQ,QAQCHOSN,QAQDD,QAQDONE,QAQFILE,QAQLEN,QAQLEVEL,QAQLN,QAQMHDR,QAQMMAX,QAQNODAT,QAQPROG,QAQQUIT,QAQREPLC,QAQRTN,QAQRTNNO,QAQRTNXT,QAQSORT,QAQTAB,QAQTEXT,QAQTODAY,QAQWP,QAQYESNO,X,XCM,XCN,Y
+4 QUIT