GECXPOST ;WISC/RFJ-fix the entry and exit menu actions ;15 Jun 95
;;2.0;GCS;**2**;MAR 14, 1995
N %,DA,DATA,FIND,NEWAPIS,NEWCODE,NEWENTRY,OLDAPIS,OLDCODE,OLDCODX,OLDENTRY
; oldapis is the old application interfaces
; newapis is the new application interfaces
; the last 2 pieces of the variable fix problems with wrong routines
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"
S NEWAPIS="BATCH|EDITBAT|RSTATUS|RBATWA|EDITCOD|CREATE|DELCODE|KEY|PURGE|RCODEBA|REBAT|RETRAN|REVCODE|TRANS|RETRAN|PURGE"
;
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
. ; add K GECSSYS to exit action of option
. S OLDCODX=$G(^DIC(19,DA,15)) I OLDCODX'["K GECSSYS" S ^DIC(19,DA,15)=$S(OLDCODX="":"",1:" ")_"K GECSSYS"
. ; change entry action to call new supported label
. S OLDENTRY=^DIC(19,DA,20)
. F %=1:1:17 I OLDENTRY[$P(OLDAPIS,"|",%) Q
. I %>16 Q
. S OLDCODE=$P(OLDAPIS,"|",%),FIND=$F(OLDENTRY,OLDCODE)
. S NEWCODE="D "_$P(NEWAPIS,"|",%)_"^GECSCALL"
. S NEWENTRY=$E(OLDENTRY,1,FIND-$L(OLDCODE)-1)_NEWCODE_$E(OLDENTRY,FIND,9999)
. S ^DIC(19,DA,20)=NEWENTRY
. I DA#100=0 W "."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECXPOST 1386 printed Dec 13, 2024@01:56:47 Page 2
GECXPOST ;WISC/RFJ-fix the entry and exit menu actions ;15 Jun 95
+1 ;;2.0;GCS;**2**;MAR 14, 1995
+2 NEW %,DA,DATA,FIND,NEWAPIS,NEWCODE,NEWENTRY,OLDAPIS,OLDCODE,OLDCODX,OLDENTRY
+3 ; oldapis is the old application interfaces
+4 ; newapis is the new application interfaces
+5 ; the last 2 pieces of the variable fix problems with wrong routines
+6 SET 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"
+7 SET NEWAPIS="BATCH|EDITBAT|RSTATUS|RBATWA|EDITCOD|CREATE|DELCODE|KEY|PURGE|RCODEBA|REBAT|RETRAN|REVCODE|TRANS|RETRAN|PURGE"
+8 ;
+9 SET DA=0
FOR
SET DA=$ORDER(^DIC(19,DA))
if 'DA
QUIT
SET DATA=$GET(^(DA,0))
IF $PIECE(DATA," ",2)="GECS"
IF $GET(^DIC(19,DA,20))["S GECSSYS"
Begin DoDot:1
+10 ; add K GECSSYS to exit action of option
+11 SET OLDCODX=$GET(^DIC(19,DA,15))
IF OLDCODX'["K GECSSYS"
SET ^DIC(19,DA,15)=$SELECT(OLDCODX="":"",1:" ")_"K GECSSYS"
+12 ; change entry action to call new supported label
+13 SET OLDENTRY=^DIC(19,DA,20)
+14 FOR %=1:1:17
IF OLDENTRY[$PIECE(OLDAPIS,"|",%)
QUIT
+15 IF %>16
QUIT
+16 SET OLDCODE=$PIECE(OLDAPIS,"|",%)
SET FIND=$FIND(OLDENTRY,OLDCODE)
+17 SET NEWCODE="D "_$PIECE(NEWAPIS,"|",%)_"^GECSCALL"
+18 SET NEWENTRY=$EXTRACT(OLDENTRY,1,FIND-$LENGTH(OLDCODE)-1)_NEWCODE_$EXTRACT(OLDENTRY,FIND,9999)
+19 SET ^DIC(19,DA,20)=NEWENTRY
+20 IF DA#100=0
WRITE "."
End DoDot:1
+21 QUIT
