| [613] | 1 | GECXPOST ;WISC/RFJ-fix the entry and exit menu actions ;15 Jun 95
|
|---|
| 2 | ;;2.0;GCS;**2**;MAR 14, 1995
|
|---|
| 3 | N %,DA,DATA,FIND,NEWAPIS,NEWCODE,NEWENTRY,OLDAPIS,OLDCODE,OLDCODX,OLDENTRY
|
|---|
| 4 | ; oldapis is the old application interfaces
|
|---|
| 5 | ; newapis is the new application interfaces
|
|---|
| 6 | ; the last 2 pieces of the variable fix problems with wrong routines
|
|---|
| 7 | S OLDAPIS="D ^GECSBATC|D ^GECSE|D BATCHES^GECSLIST|D WAITBAT^GECSLIST|D EDIT^GECSE1|D EN1^GECSA|D DEL^GECSE1|D KEY^GECSA|D ^GECSPURG|D RBAT^GECSLIST|D REBAT^GECSE1|D RETRAN^GECSE2|D REVIEW^GECSE1|D ^GECSTRAN|D RETRAN^GECSE1|D GECSPURG"
|
|---|
| 8 | S NEWAPIS="BATCH|EDITBAT|RSTATUS|RBATWA|EDITCOD|CREATE|DELCODE|KEY|PURGE|RCODEBA|REBAT|RETRAN|REVCODE|TRANS|RETRAN|PURGE"
|
|---|
| 9 | ;
|
|---|
| 10 | S DA=0 F S DA=$O(^DIC(19,DA)) Q:'DA S DATA=$G(^(DA,0)) I $P(DATA," ",2)="GECS",$G(^DIC(19,DA,20))["S GECSSYS" D
|
|---|
| 11 | . ; add K GECSSYS to exit action of option
|
|---|
| 12 | . S OLDCODX=$G(^DIC(19,DA,15)) I OLDCODX'["K GECSSYS" S ^DIC(19,DA,15)=$S(OLDCODX="":"",1:" ")_"K GECSSYS"
|
|---|
| 13 | . ; change entry action to call new supported label
|
|---|
| 14 | . S OLDENTRY=^DIC(19,DA,20)
|
|---|
| 15 | . F %=1:1:17 I OLDENTRY[$P(OLDAPIS,"|",%) Q
|
|---|
| 16 | . I %>16 Q
|
|---|
| 17 | . S OLDCODE=$P(OLDAPIS,"|",%),FIND=$F(OLDENTRY,OLDCODE)
|
|---|
| 18 | . S NEWCODE="D "_$P(NEWAPIS,"|",%)_"^GECSCALL"
|
|---|
| 19 | . S NEWENTRY=$E(OLDENTRY,1,FIND-$L(OLDCODE)-1)_NEWCODE_$E(OLDENTRY,FIND,9999)
|
|---|
| 20 | . S ^DIC(19,DA,20)=NEWENTRY
|
|---|
| 21 | . I DA#100=0 W "."
|
|---|
| 22 | Q
|
|---|
