DGINS.m

DGINS ;ALB/MRL - INSURANCE COMPANY ADD/EDIT; 13 SEP 88@2200

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

1 W !! D Q S DGINS="",DGINSW=1,DIC="^DIC(36,",DIC(0)="AEQMLZ" D ^DIC G Q:Y'>0 S DGINS=+Y,DGNEW=+$P(Y,"^",3) D ED G 1

 ;

ED D OLD S DIE=DIC,DR=".01;1;2;.05:.08;.09;.1;.111;S:X="""" Y=.114;.112;S:X="""" Y=.114;.113:.116;.131;.132;.133;",(DA,Y)=DGINS D ^DIE:DGINSW F I=.11,.13 S DGINS1(I)=$S($D(^DIC(36,DGINS,I)):^(I),1:"")

 I DGINSW S C=0 F I=1,4,5,6 S:$P(DGINS(.11),"^",I)'=$P(DGINS1(.11),"^",I) C=1 S X1=$S(I=1:.01,1:(I-2)),DGINSE(X1)=$P(DGINS1(.11),"^",I)

 I DGINSW S:$P(DGINS(.13),"^",1)'=$P(DGINS1(.13),"^",1) C=1 S DGINSE(5)=$P(DGINS1(.13),"^",1)

 I DGNEW S C=1,DGINSE(5)=$P(DGINS1(.13),"^",1) F I=1,4,5,6 S X1=$S(I=1:.01,1:(I-2)) I $P(DGINS1(.11),"^",I)]"" S DGINSE(X1)=$P(DGINS1(.11),"^",I)

 Q:'C  W:DGINSW !!,"...Updating multiple ADDRESS field with new information...",!

 I $D(^DIC(36,+DGINS,2,1,0)) S:'$D(^DIC(36,+DGINS,2,0)) ^(0)="^36.02I^1^1" S DIK="^DIC(36,"_DGINS_",2,",DA(2)=36,DA(1)=DGINS,DA=1 D ^DIK K DIK W:DGINSW "...."

 S DIC(0)="QMZL",DIC="^DIC(36,"_DGINS_",2,",DA(2)=36,DA(1)=DGINS,(DA,DINUM)=1,X=$P(DGINS1(.11),"^",1) I X]"" S:'$D(^DIC(36,+DGINS,2,0)) ^(0)="^36.02I^^" K DD,DO D DR,FILE^DICN K DINUM W:DGINSW !!,"DONE...",*7 Q

 ;

DR K DR S DIC("DR")="" F I=0:0 S I=$O(DGINSE(I)) Q:'I  S DIC("DR")=DIC("DR")_I_"///"_DGINSE(I)_";" W:DGINSW "...."

 S DIC("DR")=DIC("DR")_"6///"_DGINS_";" K DGINSE Q

 ;

Q K DGNEW,X,X1,DIC,DIE,DR,I,C,DGINS,DGINS1,DGINSE,DGINSW,DA,Y Q

 ;

ALL F DGINS=0:0 S DGINS=$O(^DIC(36,DGINS)) Q:'DGINS  S DIC="^DIC(36,",DGNEW=1,DGINSW=0 D ED W "."

 W !!,"DONE!",*7 G Q

OLD F I=.11,.13 S DGINS(I)=$S($D(^DIC(36,+DGINS,I)):^(I),1:"")

 Q

DGINS     ;ALB/MRL - INSURANCE COMPANY ADD/EDIT; 13 SEP 88@2200

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

1          WRITE !!

           DO Q

           SET DGINS=""

           SET DGINSW=1

           SET DIC="^DIC(36,"

           SET DIC(0)="AEQMLZ"

           DO ^DIC

           IF Y'>0

               GOTO Q

           SET DGINS=+Y

           SET DGNEW=+$PIECE(Y,"^",3)

           DO ED

           GOTO 1

 +1       ;

ED         DO OLD

           SET DIE=DIC

           SET DR=".01;1;2;.05:.08;.09;.1;.111;S:X="""" Y=.114;.112;S:X="""" Y=.114;.113:.116;.131;.132;.133;"

           SET (DA,Y)=DGINS

           IF DGINSW

               DO ^DIE

           FOR I=.11,.13

               SET DGINS1(I)=$SELECT($DATA(^DIC(36,DGINS,I)):^(I),1:"")

 +1        IF DGINSW

               SET C=0

               FOR I=1,4,5,6

                   IF $PIECE(DGINS(.11),"^",I)'=$PIECE(DGINS1(.11),"^",I)

                       SET C=1

                   SET X1=$SELECT(I=1:.01,1:(I-2))

                   SET DGINSE(X1)=$PIECE(DGINS1(.11),"^",I)

 +2        IF DGINSW

               IF $PIECE(DGINS(.13),"^",1)'=$PIECE(DGINS1(.13),"^",1)

                   SET C=1

               SET DGINSE(5)=$PIECE(DGINS1(.13),"^",1)

 +3        IF DGNEW

               SET C=1

               SET DGINSE(5)=$PIECE(DGINS1(.13),"^",1)

               FOR I=1,4,5,6

                   SET X1=$SELECT(I=1:.01,1:(I-2))

                   IF $PIECE(DGINS1(.11),"^",I)]""

                       SET DGINSE(X1)=$PIECE(DGINS1(.11),"^",I)

 +4        IF 'C

               QUIT 

           IF DGINSW

               WRITE !!,"...Updating multiple ADDRESS field with new information...",!

 +5        IF $DATA(^DIC(36,+DGINS,2,1,0))

               IF '$DATA(^DIC(36,+DGINS,2,0))

                   SET ^(0)="^36.02I^1^1"

               SET DIK="^DIC(36,"_DGINS_",2,"

               SET DA(2)=36

               SET DA(1)=DGINS

               SET DA=1

               DO ^DIK

               KILL DIK

               IF DGINSW

                   WRITE "...."

 +6        SET DIC(0)="QMZL"

           SET DIC="^DIC(36,"_DGINS_",2,"

           SET DA(2)=36

           SET DA(1)=DGINS

           SET (DA,DINUM)=1

           SET X=$PIECE(DGINS1(.11),"^",1)

           IF X]""

               IF '$DATA(^DIC(36,+DGINS,2,0))

                   SET ^(0)="^36.02I^^"

               KILL DD,DO

               DO DR

               DO FILE^DICN

               KILL DINUM

               IF DGINSW

                   WRITE !!,"DONE...",*7

               QUIT 

 +7       ;

DR         KILL DR

           SET DIC("DR")=""

           FOR I=0:0

               SET I=$ORDER(DGINSE(I))

               IF 'I

                   QUIT 

               SET DIC("DR")=DIC("DR")_I_"///"_DGINSE(I)_";"

               IF DGINSW

                   WRITE "...."

 +1        SET DIC("DR")=DIC("DR")_"6///"_DGINS_";"

           KILL DGINSE

           QUIT 

 +2       ;

Q          KILL DGNEW,X,X1,DIC,DIE,DR,I,C,DGINS,DGINS1,DGINSE,DGINSW,DA,Y

           QUIT 

 +1       ;

ALL        FOR DGINS=0:0

               SET DGINS=$ORDER(^DIC(36,DGINS))

               IF 'DGINS

                   QUIT 

               SET DIC="^DIC(36,"

               SET DGNEW=1

               SET DGINSW=0

               DO ED

               WRITE "."

 +1        WRITE !!,"DONE!",*7

           GOTO Q

OLD        FOR I=.11,.13

               SET DGINS(I)=$SELECT($DATA(^DIC(36,+DGINS,I)):^(I),1:"")

 +1        QUIT