DMSQP.m

DMSQP ;SFISC/EZ-PRINT SQLI TABLE POINTERS ;10/30/97  16:49

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

EN1 ; in pointers (to this table from others)

 D DT^DICRW S DMQ="" D  D EXIT

 . D OK,ASK:'DMQ,CHK:'DMQ,PR1:'DMQ

 Q

EN2 ; out pointers (from this table out)

 D DT^DICRW S DMQ="" D  D EXIT

 . D OK,ASK:'DMQ,CHK:'DMQ,CHK1:'DMQ,PR2:'DMQ

 Q

OK ; check if okay to run

 I '$O(^DMSQ("S",0)) W !?5,"Sorry, SQLI files are empty.",! S DMQ=1 Q

 I $$WAIT^DMSQT1 D  S DMQ=1 Q

 . W !?5,"Try later.  SQLI is being re-built right now."

 Q

ASK S DIC="1.5215",DIC(0)="QEAM" ; select starting-point table

 D ^DIC K DIC S DMY=+Y S:$D(DTOUT)!$D(DUOUT)!(Y=-1) DMQ=1

 Q

CHK I '$D(^DMSQ("E","F",DMY,"F")) S DMQ=1 W !,?5,"NO POINTERS",!

 Q

CHK1 ; check file access needed for navigation in PR2 report

 I DUZ(0)'="@" F DIFILE=1.5212 D  K DIAC

 . S DIAC="RD" D EN^DIAC S:'% DMQ=1

 D:DMQ 

 . W !!?5,"You need 'Read' access to one SQLI file to run this report."

 . W !?5,"It is file 1.5212."

 . W !!?5,"Contact your system manager to be granted single file access.",!

 Q

PR1 S DIC="1.5216",L=0 ; only foreign keys (screen-out primary)

 S DIS(0)="I '$D(^DMSQ(""E"",""E"",""P"",D0))"

 S DHD="TABLES POINTING TO "_$P(^DMSQ("T",DMY,0),U,1)

 S FLDS="""FROM TABLE: "";S;C5,!E_TABLE;X"

 S FLDS(1)="""VIA FOREIGN KEY: "";C5,E_NAME;X"

 S DMY1=$O(^DMSQ("DM","C",DMY,0))

 S BY(0)="^DMSQ(""E"",""C"",DMY1,",L(0)=1 D EN1^DIP

 Q

PR2 S DIC="1.5216",L=0

 S DHD="TABLES POINTED-TO BY "_$P(^DMSQ("T",DMY,0),U,1)

 S FLDS="""TO TABLE: "";S;C5,E_DOMAIN:,!DM_TABLE;X"

 S FLDS(1)="""VA FOREIGN KEY: "";C5,E_NAME;X"

 S BY(0)="DMSQ(""E"",""F"",DMY,""F"",",L(0)=1 D EN1^DIP

 Q

EXIT K DMY,DMY1,DMQ Q 

DMSQP     ;SFISC/EZ-PRINT SQLI TABLE POINTERS ;10/30/97  16:49

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

EN1       ; in pointers (to this table from others)

 +1        DO DT^DICRW

           SET DMQ=""

           Begin DoDot:1

 +2            DO OK

               IF 'DMQ

                   DO ASK

               IF 'DMQ

                   DO CHK

               IF 'DMQ

                   DO PR1

           End DoDot:1

           DO EXIT

 +3        QUIT 

EN2       ; out pointers (from this table out)

 +1        DO DT^DICRW

           SET DMQ=""

           Begin DoDot:1

 +2            DO OK

               IF 'DMQ

                   DO ASK

               IF 'DMQ

                   DO CHK

               IF 'DMQ

                   DO CHK1

               IF 'DMQ

                   DO PR2

           End DoDot:1

           DO EXIT

 +3        QUIT 

OK        ; check if okay to run

 +1        IF '$ORDER(^DMSQ("S",0))

               WRITE !?5,"Sorry, SQLI files are empty.",!

               SET DMQ=1

               QUIT 

 +2        IF $$WAIT^DMSQT1

               Begin DoDot:1

 +3                WRITE !?5,"Try later.  SQLI is being re-built right now."

               End DoDot:1

               SET DMQ=1

               QUIT 

 +4        QUIT 

ASK       ; select starting-point table

           SET DIC="1.5215"

           SET DIC(0)="QEAM"

 +1        DO ^DIC

           KILL DIC

           SET DMY=+Y

           IF $DATA(DTOUT)!$DATA(DUOUT)!(Y=-1)

               SET DMQ=1

 +2        QUIT 

CHK        IF '$DATA(^DMSQ("E","F",DMY,"F"))

               SET DMQ=1

               WRITE !,?5,"NO POINTERS",!

 +1        QUIT 

CHK1      ; check file access needed for navigation in PR2 report

 +1        IF DUZ(0)'="@"

               FOR DIFILE=1.5212

                   Begin DoDot:1

 +2                    SET DIAC="RD"

                       DO EN^DIAC

                       IF '%

                           SET DMQ=1

                   End DoDot:1

                   KILL DIAC

 +3        IF DMQ

               Begin DoDot:1

 +4                WRITE !!?5,"You need 'Read' access to one SQLI file to run this report."

 +5                WRITE !?5,"It is file 1.5212."

 +6                WRITE !!?5,"Contact your system manager to be granted single file access.",!

               End DoDot:1

 +7        QUIT 

PR1       ; only foreign keys (screen-out primary)

           SET DIC="1.5216"

           SET L=0

 +1        SET DIS(0)="I '$D(^DMSQ(""E"",""E"",""P"",D0))"

 +2        SET DHD="TABLES POINTING TO "_$PIECE(^DMSQ("T",DMY,0),U,1)

 +3        SET FLDS="""FROM TABLE: "";S;C5,!E_TABLE;X"

 +4        SET FLDS(1)="""VIA FOREIGN KEY: "";C5,E_NAME;X"

 +5        SET DMY1=$ORDER(^DMSQ("DM","C",DMY,0))

 +6        SET BY(0)="^DMSQ(""E"",""C"",DMY1,"

           SET L(0)=1

           DO EN1^DIP

 +7        QUIT 

PR2        SET DIC="1.5216"

           SET L=0

 +1        SET DHD="TABLES POINTED-TO BY "_$PIECE(^DMSQ("T",DMY,0),U,1)

 +2        SET FLDS="""TO TABLE: "";S;C5,E_DOMAIN:,!DM_TABLE;X"

 +3        SET FLDS(1)="""VA FOREIGN KEY: "";C5,E_NAME;X"

 +4        SET BY(0)="DMSQ(""E"",""F"",DMY,""F"","

           SET L(0)=1

           DO EN1^DIP

 +5        QUIT 

EXIT       KILL DMY,DMY1,DMQ

           QUIT