BLRAPPH.m

BLRAPPH ;DAOU/ALA-Find Primary Menus for Providers [ 11/18/2002  1:39 PM ]

 ;;5.2;LR;**1013,1015**;NOV 18, 2002

 ;

 ;**Program Description**

 ;  This program can be run to find the primary menu

 ;  options for potential participating providers

 ;

EN ;  Starting point

 S PNM="" D ^%ZIS Q:POP

 ;

 ;  Go through the provider cross-reference

PNAM S PNM=$O(^VA(200,"AK.PROVIDER",PNM)) G EXIT:PNM=""

 S IEN=""

IEN S IEN=$O(^VA(200,"AK.PROVIDER",PNM,IEN)) G PNAM:IEN=""

 ;

 ;  Check for termination date

 I $P($G(^VA(200,IEN,0)),U,11)'="" G IEN

 ;

 ;  Get the primary menu pointer

 S PMEN=$G(^VA(200,IEN,201)) G IEN:PMEN=""

 S PMENU=$S($G(^DIC(19,PMEN,0))="":PMEN,1:$P($G(^DIC(19,PMEN,0)),U,1)) W !,IEN,?6,PNM,?40,PMENU,?60,$P($G(^(0)),U,2)

 G IEN

EXIT D ^%ZISC

 Q

BLRAPPH   ;DAOU/ALA-Find Primary Menus for Providers [ 11/18/2002  1:39 PM ]

 +1       ;;5.2;LR;**1013,1015**;NOV 18, 2002

 +2       ;

 +3       ;**Program Description**

 +4       ;  This program can be run to find the primary menu

 +5       ;  options for potential participating providers

 +6       ;

EN        ;  Starting point

 +1        SET PNM=""

           DO ^%ZIS

           IF POP

               QUIT 

 +2       ;

 +3       ;  Go through the provider cross-reference

PNAM       SET PNM=$ORDER(^VA(200,"AK.PROVIDER",PNM))

           IF PNM=""

               GOTO EXIT

 +1        SET IEN=""

IEN        SET IEN=$ORDER(^VA(200,"AK.PROVIDER",PNM,IEN))

           IF IEN=""

               GOTO PNAM

 +1       ;

 +2       ;  Check for termination date

 +3        IF $PIECE($GET(^VA(200,IEN,0)),U,11)'=""

               GOTO IEN

 +4       ;

 +5       ;  Get the primary menu pointer

 +6        SET PMEN=$GET(^VA(200,IEN,201))

           IF PMEN=""

               GOTO IEN

 +7        SET PMENU=$SELECT($GET(^DIC(19,PMEN,0))="":PMEN,1:$PIECE($GET(^DIC(19,PMEN,0)),U,1))

           WRITE !,IEN,?6,PNM,?40,PMENU,?60,$PIECE($GET(^(0)),U,2)

 +8        GOTO IEN

EXIT       DO ^%ZISC

 +1        QUIT