| [613] | 1 | QACCODE ;HISC/CEW - Enter/Edit a Local Contact Issue Code ;1/30/95 09:02
|
|---|
| 2 | ;;2.0;Patient Representative;**3**;07/25/1995
|
|---|
| 3 | ;*********Variable List*********************************
|
|---|
| 4 | ;ALPHCODE =The major heading (ALPHA) code
|
|---|
| 5 | ;QASPECT =The IEN of the Quality Aspect
|
|---|
| 6 | ;NEXNUM =Next free number
|
|---|
| 7 | ;NUM =The last code number
|
|---|
| 8 | ;NEWIEN =The IEN of the new code
|
|---|
| 9 | ;QACIEN =The IEN of the Issue
|
|---|
| 10 | ;
|
|---|
| 11 | ;
|
|---|
| 12 | ;
|
|---|
| 13 | ;
|
|---|
| 14 | ; This option no longer in use, as Issue Codes can no longer be
|
|---|
| 15 | ; entered or edited
|
|---|
| 16 | W !!?5,"Issue Codes can no longer be entered or edited."
|
|---|
| 17 | W !?5,"Only National Issue Codes are valid."
|
|---|
| 18 | W !?5,"The Issue Code list will be periodically evaluated and updated."
|
|---|
| 19 | Q
|
|---|
| 20 | SLCHEAD ;
|
|---|
| 21 | ;Selects code to edit code text and status or a major heading
|
|---|
| 22 | ;under which a new code will reside.
|
|---|
| 23 | W ! K DIC S DIC="^QA(745.2,",DIC(0)="AEQZ"
|
|---|
| 24 | S DIC("A")="Select ISSUE CODE: "
|
|---|
| 25 | S DIC("S")="I ($P(^(0),U,5)'=""N""!($P(^(0),U,2)=1)),($P(^(0),U,1)?2U.N)"
|
|---|
| 26 | D ^DIC K DIC G:Y'>0 EXIT
|
|---|
| 27 | S ALPHCODE=Y(0,0),NUM=99,QASPECT=$P(Y(0),"^",4),QACIEN=+Y
|
|---|
| 28 | ;Find out if selection is a major code (ALPHA only) heading
|
|---|
| 29 | ;to ENTER a new code text or else a numbered code for EDITing.
|
|---|
| 30 | I $P(Y(0),U,2)="1" S FLAG=0 D ENTER G SLCHEAD
|
|---|
| 31 | E D EDIT G SLCHEAD
|
|---|
| 32 | ENTER ;Enter a new code text. Code number is built in background.
|
|---|
| 33 | F S NUM=$O(^QA(745.2,"AH",ALPHCODE,NUM)) D Q:FLAG=1
|
|---|
| 34 | .I NUM'>200 S NEXNUM=ALPHCODE_"201" S FLAG=1 Q
|
|---|
| 35 | .S NEXNUM=ALPHCODE_(NUM+1)
|
|---|
| 36 | .I '$D(^QA(745.2,"B",NEXNUM)) S FLAG=1
|
|---|
| 37 | .Q
|
|---|
| 38 | I $E(NEXNUM,2,4)>999 W !,"Only 999 issue codes allowed per heading! Select a different heading." G SLCHEAD
|
|---|
| 39 | K DIR S DIR("A")="Are you adding '"_NEXNUM_"' as a new Contact Issue Code",DIR("0")="Y",DIR("B")="YES"
|
|---|
| 40 | D ^DIR K DIR Q:($D(DIRUT))!(Y=0)
|
|---|
| 41 | S DIC(0)="EMQLZ",DIC="^QA(745.2,",X=NEXNUM
|
|---|
| 42 | D FILE^DICN G EXIT:Y<1 K DIC
|
|---|
| 43 | S NEWIEN=+Y
|
|---|
| 44 | L +^QA(745.2,NEWIEN):0 I '$T W "Try again later." G SLCHEAD
|
|---|
| 45 | K DIE S DIE="^QA(745.2,",DA=NEWIEN,DR="1////0;3////"_QASPECT_";4////L;2;5"
|
|---|
| 46 | D ^DIE K DIE L -^QA(745.2,NEWIEN)
|
|---|
| 47 | Q
|
|---|
| 48 | EDIT ;Edit an existing code text.
|
|---|
| 49 | L +^QA(745.2,QACIEN):0 I '$T W "Try again later." G SLCHEAD
|
|---|
| 50 | K DIE S DIE="^QA(745.2,",DA=QACIEN,DR="2;4;5"
|
|---|
| 51 | D ^DIE K DIE L -^QA(745.2,QACIEN)
|
|---|
| 52 | Q
|
|---|
| 53 | EXIT ;
|
|---|
| 54 | K DIC,DIE,QACIEN,ALPHCODE,NEXNUM,NEWIEN,NUM,Y,X,FLAG
|
|---|
| 55 | K DA,DIRUT,DR,QASPECT
|
|---|
| 56 | Q
|
|---|
