ADEDDTH1.m

ADEDDTH1 ; IHS/HQT/MJL - IHS-RPMS/MLQ CONTINUATION OF ADEDDTH ;  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

 W !!,"LOOKING FOR MATCHING PROVIDER NAME FOR "_ADEPROV(1)

 S DIC=ADEPRVGN,DIC(0)="EMZ",X=ADEPROV(1) D ^DIC

 I Y'<1 S %=1 W !!,"MATCH FOUND, ARE YOU CHANGING "_X_"'S RECORD" D YN^DICN S:%=2 Y=-1

 I Y<1 W !,"NO MATCH FOUND" D NEWONE I 1

 E  S DA=+Y,DIE=DIC

 S DR="1///"_ADEPROV(2)_";2///"_ADEPROV(3)_";3///"_ADEPROV(4) D ^DIE

 Q

NEWONE ;

 W !,"NEW RECORD BEING ADDED . . ."

 S ADEA="0",ADEGN=DIC_"ADEA)",ADELAST=0,ADENE=1

 F ADEIDX=0:0 S ADEA=$O(@ADEGN) Q:ADEA=""  I "1234567890"[ADEA S ADELAST=ADEA,ADENE=ADENE+1

 S DA=ADELAST+1,DIE=DIC,DR=".01///"_X D ^DIE

 S ADEGN=DIC_"0)",$P(@ADEGN,"^",3)=DA,$P(@ADEGN,"^",4)=ADENE

 K ADEA,ADEGN,ADEIDX,ADENE,ADELAST

 Q

ADEDDTH1  ; IHS/HQT/MJL - IHS-RPMS/MLQ CONTINUATION OF ADEDDTH ;  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

 +2        WRITE !!,"LOOKING FOR MATCHING PROVIDER NAME FOR "_ADEPROV(1)

 +3        SET DIC=ADEPRVGN

           SET DIC(0)="EMZ"

           SET X=ADEPROV(1)

           DO ^DIC

 +4        IF Y'<1

               SET %=1

               WRITE !!,"MATCH FOUND, ARE YOU CHANGING "_X_"'S RECORD"

               DO YN^DICN

               IF %=2

                   SET Y=-1

 +5        IF Y<1

               WRITE !,"NO MATCH FOUND"

               DO NEWONE

               IF 1

 +6       IF '$TEST

               SET DA=+Y

               SET DIE=DIC

 +7        SET DR="1///"_ADEPROV(2)_";2///"_ADEPROV(3)_";3///"_ADEPROV(4)

           DO ^DIE

 +8        QUIT 

NEWONE    ;

 +1        WRITE !,"NEW RECORD BEING ADDED . . ."

 +2        SET ADEA="0"

           SET ADEGN=DIC_"ADEA)"

           SET ADELAST=0

           SET ADENE=1

 +3        FOR ADEIDX=0:0

               SET ADEA=$ORDER(@ADEGN)

               IF ADEA=""

                   QUIT 

               IF "1234567890"[ADEA

                   SET ADELAST=ADEA

                   SET ADENE=ADENE+1

 +4        SET DA=ADELAST+1

           SET DIE=DIC

           SET DR=".01///"_X

           DO ^DIE

 +5        SET ADEGN=DIC_"0)"

           SET $PIECE(@ADEGN,"^",3)=DA

           SET $PIECE(@ADEGN,"^",4)=ADENE

 +6        KILL ADEA,ADEGN,ADEIDX,ADENE,ADELAST

 +7        QUIT