XBDIR.m

XBDIR ; IHS/ADC/GTH - DIR INTERFACE ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 ; The purpose of routine XBDIR is to provide interface

 ; methodology for a call to ^DIR, to ensure correct handling

 ; of variables, and to provide for the expressiveness of an

 ; extrinsic function.

 ;

 ; There is no requirement to use the entry point, below.

 ;

 ; The format of the call is to SET a local variable to the

 ; output of the call to DIR^XBDIR(), which will be Y at the

 ; bottom of this routine, or, less likely, WRITE the value.

 ;

 ; An example of the call is:

 ;            S %=$$DIR^XBDIR(<actual_parameter_list>)

 ; where the <actual_parameter_list> is:

 ;(DIR(0),DIR("A"),DIR("B"),DIR("T"),DIR("?"),DIR("??"),<skip>)

 ; where <skip> is the number of lines to skip before the call

 ; to ^DIR.

 ;

 ; Examples:

 ;

 ; S %=$$DIR^XBDIR("N^1:2","Select report method",2,"","Produ

 ; ce report by FY or Dates","^D HELP^<your_routine>",300,2)

 ;

 ; S <namespace>FY=$$DIR^XBDIR("NO","Object Class Code Summar

 ; y for FISCAL YEAR ",FY,$G(DTIME,500),"Enter a FOUR DIGIT F

 ; ISCAL YEAR","^D SB1^<your_routine>")

 ;

 ;

DIR(O,A,B,T,Q,H,R) ;PEP - Extrinsic interface to ^DIR.

 I '$L($G(O)) Q -1

 NEW DA,DIR

 S DIR(0)=O

 I $D(A) D

 . I $L($G(A)) S DIR("A")=A

 . I $L($O(A(""))) S O="" F  S O=$O(A(O)) Q:'$L(O)  S DIR("A",O)=A(O)

 .Q

 I $L($G(B)) S DIR("B")=B

 I $G(T) S DIR("T")=T

 I $D(Q) D

 . I $L($G(Q)) S DIR("?")=Q

 . I $L($O(Q(""))) S O="" F  S O=$O(Q(O)) Q:'$L(O)  S DIR("?",O)=Q(O)

 .Q

 I $L($G(H)) S DIR("??")=H

 I $G(R) F A=1:1:R W !

 KILL O,A,B,T,Q,H,R,DTOUT,DUOUT,DIRUT,DIROUT

 D ^DIR

 Q Y

 ;

XBDIR     ; IHS/ADC/GTH - DIR INTERFACE ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ; The purpose of routine XBDIR is to provide interface

 +4       ; methodology for a call to ^DIR, to ensure correct handling

 +5       ; of variables, and to provide for the expressiveness of an

 +6       ; extrinsic function.

 +7       ;

 +8       ; There is no requirement to use the entry point, below.

 +9       ;

 +10      ; The format of the call is to SET a local variable to the

 +11      ; output of the call to DIR^XBDIR(), which will be Y at the

 +12      ; bottom of this routine, or, less likely, WRITE the value.

 +13      ;

 +14      ; An example of the call is:

 +15      ;            S %=$$DIR^XBDIR(<actual_parameter_list>)

 +16      ; where the <actual_parameter_list> is:

 +17      ;(DIR(0),DIR("A"),DIR("B"),DIR("T"),DIR("?"),DIR("??"),<skip>)

 +18      ; where <skip> is the number of lines to skip before the call

 +19      ; to ^DIR.

 +20      ;

 +21      ; Examples:

 +22      ;

 +23      ; S %=$$DIR^XBDIR("N^1:2","Select report method",2,"","Produ

 +24      ; ce report by FY or Dates","^D HELP^<your_routine>",300,2)

 +25      ;

 +26      ; S <namespace>FY=$$DIR^XBDIR("NO","Object Class Code Summar

 +27      ; y for FISCAL YEAR ",FY,$G(DTIME,500),"Enter a FOUR DIGIT F

 +28      ; ISCAL YEAR","^D SB1^<your_routine>")

 +29      ;

 +30      ;

DIR(O,A,B,T,Q,H,R) ;PEP - Extrinsic interface to ^DIR.

 +1        IF '$LENGTH($GET(O))

               QUIT -1

 +2        NEW DA,DIR

 +3        SET DIR(0)=O

 +4        IF $DATA(A)

               Begin DoDot:1

 +5                IF $LENGTH($GET(A))

                       SET DIR("A")=A

 +6                IF $LENGTH($ORDER(A("")))

                       SET O=""

                       FOR 

                           SET O=$ORDER(A(O))

                           IF '$LENGTH(O)

                               QUIT 

                           SET DIR("A",O)=A(O)

 +7                QUIT 

               End DoDot:1

 +8        IF $LENGTH($GET(B))

               SET DIR("B")=B

 +9        IF $GET(T)

               SET DIR("T")=T

 +10       IF $DATA(Q)

               Begin DoDot:1

 +11               IF $LENGTH($GET(Q))

                       SET DIR("?")=Q

 +12               IF $LENGTH($ORDER(Q("")))

                       SET O=""

                       FOR 

                           SET O=$ORDER(Q(O))

                           IF '$LENGTH(O)

                               QUIT 

                           SET DIR("?",O)=Q(O)

 +13               QUIT 

               End DoDot:1

 +14       IF $LENGTH($GET(H))

               SET DIR("??")=H

 +15       IF $GET(R)

               FOR A=1:1:R

                   WRITE !

 +16       KILL O,A,B,T,Q,H,R,DTOUT,DUOUT,DIRUT,DIROUT

 +17       DO ^DIR

 +18       QUIT Y

 +19      ;