AQAQMBE.m

AQAQMBE ;IHS/ANMC/LJF - EDIT MED BOARD CERT. ENTRIES; [ 05/27/92  11:17 AM ]

 ;;2.2;STAFF CREDENTIALS;;01 OCT 1992

 ;

 ;must have DA set

 ;

DISPLAY ;EP;***> display any entries already in med board cert file

 W !!

 S (AQAX,AQACNT)=0,AQAQDA=DA

 F  S AQAX=$O(^AQAQMB("C",DA,AQAX)) Q:AQAX'=+AQAX  D

 .S AQACNT=AQACNT+1,AQA(AQACNT)=AQAX

 .S Y=$P(^AQAQMB(AQAX,0),U),C=$P(^DD(9002161.1,.01,0),U,2) D Y^DIQ

 .W !,AQACNT,")  ",Y

 .Q

 G ADD:AQACNT=0

 S AQACNT=AQACNT+1 W !,AQACNT,")  ADD NEW ENTRY"

 ;

 W !

CHOOSE K DIR S DIR(0)="NO^1:"_AQACNT

 S DIR("A")="Choose ONE from list OR hit <return> to continue"

 D ^DIR G END:X="",END:$D(DIRUT),CHOOSE:Y=-1

 I +Y=AQACNT G ADD

 E  S DA=AQA(+Y) G EDIT

 ;

ADD K DIC S DIC=9002156,DIC(0)="AQEMZ" D ^DIC

 G END:X="",END:X="^",ADD:Y=-1

 K DIC,DD S DIC="^AQAQMB(",X=+Y,DIC("DR")=".02///^S X=""`""_AQAQDA"

 S DIC(0)="L" D FILE^DICN

 S DA=+Y

 ;

EDIT K DIC,DIE S DIDEL=9002161.1,DIE=9002161.1,DR="[AQAQMBEDIT]" D ^DIE

 ;

 K DIR S DIR(0)="Y",DIR("B")="NO"

 S DIR("A")="Do you wish to ADD or EDIT another Board Certification"

 D ^DIR I Y=1 S DA=AQAQDA G DISPLAY

 ;

END S DA=AQAQDA K AQAX,AQACNT,AQA,DIR,DIE,DIC Q

AQAQMBE   ;IHS/ANMC/LJF - EDIT MED BOARD CERT. ENTRIES; [ 05/27/92  11:17 AM ]

 +1       ;;2.2;STAFF CREDENTIALS;;01 OCT 1992

 +2       ;

 +3       ;must have DA set

 +4       ;

DISPLAY   ;EP;***> display any entries already in med board cert file

 +1        WRITE !!

 +2        SET (AQAX,AQACNT)=0

           SET AQAQDA=DA

 +3        FOR 

               SET AQAX=$ORDER(^AQAQMB("C",DA,AQAX))

               IF AQAX'=+AQAX

                   QUIT 

               Begin DoDot:1

 +4                SET AQACNT=AQACNT+1

                   SET AQA(AQACNT)=AQAX

 +5                SET Y=$PIECE(^AQAQMB(AQAX,0),U)

                   SET C=$PIECE(^DD(9002161.1,.01,0),U,2)

                   DO Y^DIQ

 +6                WRITE !,AQACNT,")  ",Y

 +7                QUIT 

               End DoDot:1

 +8        IF AQACNT=0

               GOTO ADD

 +9        SET AQACNT=AQACNT+1

           WRITE !,AQACNT,")  ADD NEW ENTRY"

 +10      ;

 +11       WRITE !

CHOOSE     KILL DIR

           SET DIR(0)="NO^1:"_AQACNT

 +1        SET DIR("A")="Choose ONE from list OR hit <return> to continue"

 +2        DO ^DIR

           IF X=""

               GOTO END

           IF $DATA(DIRUT)

               GOTO END

           IF Y=-1

               GOTO CHOOSE

 +3        IF +Y=AQACNT

               GOTO ADD

 +4       IF '$TEST

               SET DA=AQA(+Y)

               GOTO EDIT

 +5       ;

ADD        KILL DIC

           SET DIC=9002156

           SET DIC(0)="AQEMZ"

           DO ^DIC

 +1        IF X=""

               GOTO END

           IF X="^"

               GOTO END

           IF Y=-1

               GOTO ADD

 +2        KILL DIC,DD

           SET DIC="^AQAQMB("

           SET X=+Y

           SET DIC("DR")=".02///^S X=""`""_AQAQDA"

 +3        SET DIC(0)="L"

           DO FILE^DICN

 +4        SET DA=+Y

 +5       ;

EDIT       KILL DIC,DIE

           SET DIDEL=9002161.1

           SET DIE=9002161.1

           SET DR="[AQAQMBEDIT]"

           DO ^DIE

 +1       ;

 +2        KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="NO"

 +3        SET DIR("A")="Do you wish to ADD or EDIT another Board Certification"

 +4        DO ^DIR

           IF Y=1

               SET DA=AQAQDA

               GOTO DISPLAY

 +5       ;

END        SET DA=AQAQDA

           KILL AQAX,AQACNT,AQA,DIR,DIE,DIC

           QUIT