AGELGMED.m

AGELGMED ;ITSC/SD/SDR - ELIGIBILITY MODIFIERS FILE EDIT ; 6/21/2002 

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

EN ;Select entry

 W !! K DIC

 S DINUM=$O(^AUPNELM(999999),-1)+1   ;go get last entry used

 I DINUM<1000 S DINUM=1001

 S DIC="^AUPNELM("

 S DIC(0)="AEQLMZ"

 S DIC("A")="ELIGIBILITY MODIFIERS ENTRY: "

 D ^DIC

 G:Y'>0 EXIT

 I $P($G(Y),"^",3)="" D  ;not a new entry

 .S (DA,AGDA1)=+Y

 .I DA<1000 W !,"This is a standard entry that cannot be edited!" Q

 .K DIE S DIE=DIC,DR=".01;.02"

 .D ^DIE

ENTRY ;

EXIT ;

 K DIC,DIE,AGDA1

 Q

AGELGMED  ;ITSC/SD/SDR - ELIGIBILITY MODIFIERS FILE EDIT ; 6/21/2002 

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

EN        ;Select entry

 +1        WRITE !!

           KILL DIC

 +2       ;go get last entry used

           SET DINUM=$ORDER(^AUPNELM(999999),-1)+1

 +3        IF DINUM<1000

               SET DINUM=1001

 +4        SET DIC="^AUPNELM("

 +5        SET DIC(0)="AEQLMZ"

 +6        SET DIC("A")="ELIGIBILITY MODIFIERS ENTRY: "

 +7        DO ^DIC

 +8        IF Y'>0

               GOTO EXIT

 +9       ;not a new entry

           IF $PIECE($GET(Y),"^",3)=""

               Begin DoDot:1

 +10               SET (DA,AGDA1)=+Y

 +11               IF DA<1000

                       WRITE !,"This is a standard entry that cannot be edited!"

                       QUIT 

 +12               KILL DIE

                   SET DIE=DIC

                   SET DR=".01;.02"

 +13               DO ^DIE

               End DoDot:1

ENTRY     ;

EXIT      ;

 +1        KILL DIC,DIE,AGDA1

 +2        QUIT