- 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
