Routine: ABMDLINK

ABMDLINK ; IHS/ASDST/DMJ - Routine to Account for PCC Merge ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Original;TMD;

 ; This routine is called by the PCC Visit Merge Utility

 ;   The following variables are passed from PCC and thus

 ;   should not be killed:

 ;     APCDVMF - Merge from IEN

 ;     APCDVMT - Merge to IEN

EXT ;PEP - External Package Entry Point

 Q:'$D(APCDVMF)!'$D(APCDVMT)

CLM S DA(1)="" F  S DA(1)=$O(^ABMDCLM(DUZ(2),"AV",APCDVMF,DA(1))) Q:'DA(1)  D

 .S DA=0 S DA=$O(^ABMDCLM(DUZ(2),"AV",APCDVMF,DA(1),DA)) Q:'DA  D

 ..K DIC,DD,DO

 ..S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",11,",DIC(0)="LE",(DINUM,X)=APCDVMT

 ..D FILE^DICN Q:Y<1

 ..S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",11,"

 ..D ^DIK

BILL S DA(1)="" F  S DA(1)=$O(^ABMDBILL(DUZ(2),"AV",APCDVMF,DA(1))) Q:'DA(1)  D

 .S DA=0 S DA=$O(^ABMDBILL(DUZ(2),"AV",APCDVMF,DA(1),DA)) Q:'DA  D

 ..K DIC,DD,DO

 ..S DIC="^ABMDBILL(DUZ(2),"_DA(1)_",11,",DIC(0)="LE",(DINUM,X)=APCDVMT

 ..D FILE^DICN

XIT Q

ABMDLINK  ; IHS/ASDST/DMJ - Routine to Account for PCC Merge ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Original;TMD;

 +3       ; This routine is called by the PCC Visit Merge Utility

 +4       ;

 +5       ;   The following variables are passed from PCC and thus

 +6       ;   should not be killed:

 +7       ;     APCDVMF - Merge from IEN

 +8       ;     APCDVMT - Merge to IEN

 +9       ;

EXT       ;PEP - External Package Entry Point

 +1        IF '$DATA(APCDVMF)!'$DATA(APCDVMT)

               QUIT

CLM        SET DA(1)=""

FOR

               SET DA(1)=$ORDER(^ABMDCLM(DUZ(2),"AV",APCDVMF,DA(1)))

               IF 'DA(1)

                   QUIT

               Begin DoDot:1

 +1                SET DA=0

                   SET DA=$ORDER(^ABMDCLM(DUZ(2),"AV",APCDVMF,DA(1),DA))

                   IF 'DA

                       QUIT

                   Begin DoDot:2

 +2                    KILL DIC,DD,DO

 +3                    SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",11,"

                       SET DIC(0)="LE"

                       SET (DINUM,X)=APCDVMT

 +4                    DO FILE^DICN

                       IF Y<1

                           QUIT

 +5                    SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_",11,"

 +6                    DO ^DIK

                   End DoDot:2

               End DoDot:1

 +7       ;

BILL       SET DA(1)=""

FOR

               SET DA(1)=$ORDER(^ABMDBILL(DUZ(2),"AV",APCDVMF,DA(1)))

               IF 'DA(1)

                   QUIT

               Begin DoDot:1

 +1                SET DA=0

                   SET DA=$ORDER(^ABMDBILL(DUZ(2),"AV",APCDVMF,DA(1),DA))

                   IF 'DA

                       QUIT

                   Begin DoDot:2

 +2                    KILL DIC,DD,DO

 +3                    SET DIC="^ABMDBILL(DUZ(2),"_DA(1)_",11,"

                       SET DIC(0)="LE"

                       SET (DINUM,X)=APCDVMT

 +4                    DO FILE^DICN

                   End DoDot:2

               End DoDot:1

 +5       ;

XIT        QUIT

ABMDLINK.m