- AQAQMLE ;IHS/ANMC/LJF - EDIT MED LICENSE ENTRIES; [ 05/27/92 11:12 AM ]
- ;;2.2;STAFF CREDENTIALS;;01 OCT 1992
- ;
- ;must have DA set
- ;
- DISPLAY ;EP;***> display any entries already in med licensure file
- W !!
- S (AQAX,AQACNT)=0,AQAQDA=DA
- F S AQAX=$O(^AQAQML("C",DA,AQAX)) Q:AQAX'=+AQAX D
- .S AQACNT=AQACNT+1,AQA(AQACNT)=AQAX
- .S Y=$P(^AQAQML(AQAX,0),U),C=$P(^DD(9002161.2,.01,0),U,2) D Y^DIQ
- .W !,AQACNT,") ",Y ;med license state
- .S AQAQLAST=$P($G(^AQAQML(AQAX,1,0)),U,3) ;expiration date
- .I AQAQLAST>0 S Y=$P(^AQAQML(AQAX,1,AQAQLAST,0),U),C=$P(^DD(9002161.21,.01,0),U,2) D Y^DIQ W ?35,"Expires: ",Y
- .Q
- G ADD:AQACNT=0 ;go directly to add if first entry
- S AQACNT=AQACNT+1 W !,AQACNT,") ADD NEW ENTRY"
- ;
- CHOOSE W ! 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=5,DIC(0)="AQEMZ" D ^DIC
- G END:X="",END:X="^",ADD:Y=-1
- K DIC,DD S DIC="^AQAQML(",X=+Y,DIC("DR")=".02///^S X=""`""_AQAQDA"
- S DLAYGO=9002161.2,DIC(0)="L" D FILE^DICN
- S DA=+Y
- ;
- EDIT K DIC,DIE S DIDEL=9002161.2,DIE=9002161.2,DR="[AQAQMLEDIT]" D ^DIE
- ;
- K DIR S DIR(0)="Y",DIR("B")="NO"
- S DIR("A")="Do you wish to ADD or EDIT another Medical License"
- D ^DIR I Y=1 S DA=AQAQDA G DISPLAY
- ;
- END S DA=AQAQDA K AQAX,AQACNT,AQA,DIR,DIE,DIC Q
- AQAQMLE ;IHS/ANMC/LJF - EDIT MED LICENSE ENTRIES; [ 05/27/92 11:12 AM ]
- +1 ;;2.2;STAFF CREDENTIALS;;01 OCT 1992
- +2 ;
- +3 ;must have DA set
- +4 ;
- DISPLAY ;EP;***> display any entries already in med licensure file
- +1 WRITE !!
- +2 SET (AQAX,AQACNT)=0
- SET AQAQDA=DA
- +3 FOR
- SET AQAX=$ORDER(^AQAQML("C",DA,AQAX))
- IF AQAX'=+AQAX
- QUIT
- Begin DoDot:1
- +4 SET AQACNT=AQACNT+1
- SET AQA(AQACNT)=AQAX
- +5 SET Y=$PIECE(^AQAQML(AQAX,0),U)
- SET C=$PIECE(^DD(9002161.2,.01,0),U,2)
- DO Y^DIQ
- +6 ;med license state
- WRITE !,AQACNT,") ",Y
- +7 ;expiration date
- SET AQAQLAST=$PIECE($GET(^AQAQML(AQAX,1,0)),U,3)
- +8 IF AQAQLAST>0
- SET Y=$PIECE(^AQAQML(AQAX,1,AQAQLAST,0),U)
- SET C=$PIECE(^DD(9002161.21,.01,0),U,2)
- DO Y^DIQ
- WRITE ?35,"Expires: ",Y
- +9 QUIT
- End DoDot:1
- +10 ;go directly to add if first entry
- IF AQACNT=0
- GOTO ADD
- +11 SET AQACNT=AQACNT+1
- WRITE !,AQACNT,") ADD NEW ENTRY"
- +12 ;
- CHOOSE WRITE !
- 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=5
- 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="^AQAQML("
- SET X=+Y
- SET DIC("DR")=".02///^S X=""`""_AQAQDA"
- +3 SET DLAYGO=9002161.2
- SET DIC(0)="L"
- DO FILE^DICN
- +4 SET DA=+Y
- +5 ;
- EDIT KILL DIC,DIE
- SET DIDEL=9002161.2
- SET DIE=9002161.2
- SET DR="[AQAQMLEDIT]"
- 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 Medical License"
- +4 DO ^DIR
- IF Y=1
- SET DA=AQAQDA
- GOTO DISPLAY
- +5 ;
- END SET DA=AQAQDA
- KILL AQAX,AQACNT,AQA,DIR,DIE,DIC
- QUIT
