BSDAP.m

BSDAP ; IHS/ANMC/LJF - APPT PROFILE MENU ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;

 ; Displays menu of choices for appt profile question

 NEW BSDP,BSD,X,Y

 S BSDP=+$G(XQORNOD) Q:'BSDP    ;menu protocol

 D FULL^VALM1 W !

 S BSD=0 F  S BSD=$O(^ORD(101,BSDP,10,BSD)) Q:'BSD  D

 . S X=$G(^ORD(101,BSDP,10,BSD,0)) Q:'X

 . S Y=$$GET1^DIQ(101,+X,1)             ;menu item text

 . W !,$P(X,U,2),?10,Y                  ;display mnuemonic & text

 Q

BSDAP     ; IHS/ANMC/LJF - APPT PROFILE MENU ; 

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

 +3       ; Displays menu of choices for appt profile question

 +4        NEW BSDP,BSD,X,Y

 +5       ;menu protocol

           SET BSDP=+$GET(XQORNOD)

           IF 'BSDP

               QUIT 

 +6        DO FULL^VALM1

           WRITE !

 +7        SET BSD=0

           FOR 

               SET BSD=$ORDER(^ORD(101,BSDP,10,BSD))

               IF 'BSD

                   QUIT 

               Begin DoDot:1

 +8                SET X=$GET(^ORD(101,BSDP,10,BSD,0))

                   IF 'X

                       QUIT 

 +9       ;menu item text

                   SET Y=$$GET1^DIQ(101,+X,1)

 +10      ;display mnuemonic & text

                   WRITE !,$PIECE(X,U,2),?10,Y

               End DoDot:1

 +11       QUIT