QAQAHOCZ.m

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

MENUHDR ; *** Prompt user for the sort/print menu screen header

 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 ---QAQAHOCZ   2413     printed  Apr 09, 2024@21:33:55                                                                                                                                                                                                    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

MENUHDR   ; *** Prompt user for the sort/print menu screen header

 +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