Routine: ABMDTGAS

ABMDTGAS ; IHS/ASDST/DMJ - Remap Group Names for an Employer ;

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

;;

 ; this enables the mass changes of group names for all

 ; policies associated with one employer

 ; select Employer to remap

 ; select New Group name

 ; scan all policies for that employer and change the group name

 ; to the one selected

S ;

 W !!,"This utility allows for the mass assignment of a specified Group Plan to the",!,"policies of each employee for a selected Employer.",!

 K DIR S DIR(0)="Y",DIR("A")="Do you wish to run this utility program"

 D ^DIR Q:'$G(Y)

SEL W ! K DIC S DIC="^AUTNEMPL(",DIC(0)="AEQMZ" D ^DIC I Y'>0 W !,"NONE SELECTED EXITING OPTION",!,*7 H 3 G XIT ;--->

 S ABMEMP=+Y,ABMEMPNM=Y(0,0)

 W ! K DIC S DIC="^AUTNEGRP(",DIC("A")="Select GROUP PLAN: ",DIC(0)="AEQMZ" D ^DIC I Y'>0 W *7 G END ;--->

 S ABMGRP=+Y,ABMGRPNM=Y(0,0)

 W !!,"You have selected to assign all employees of: ",ABMEMPNM

 W !?29," the Group Plan: ",ABMGRPNM

 W ! K DIR S DIR(0)="Y",DIR("A")="Is this Correct (Y/N)" D ^DIR G XIT:$D(DIRUT)!$D(DIROUT),END:Y=0 ;--->

SCAN1 ;EP scan "AE" of policy holder file

 S ABMDA=0,DIE="^AUPN3PPH(",DR=".06////"_ABMGRP

 F ABMC1=0:1 S ABMDA=$O(^AUPN3PPH("AE",ABMEMP,ABMDA)) Q:'ABMDA  D  Q:$D(ABM("DIE-FAIL"))

 .I '$D(ZTQUEUED),(ABMC1#100) W "."

 .S DA=ABMDA D ^ABMDDIE

SCAN2 ;EP scan the patient file to pick up those policies that have

 ;registration links (the employer pointer is not stored in the Policy file

 S ABMDFN=0,DIE="^AUPN3PPH(",DR=".06////"_ABMGRP,ABMC3=0

 I $D(^AUPNPAT("AF",ABMEMP)) F ABMC2=0:1 S ABMDFN=$O(^AUPNPAT("AF",ABMEMP,ABMDFN)) Q:'ABMDFN  D  Q:$D(ABM("DIE-FAIL"))

 .I '$D(ZTQUEUED),(ABMC2#100) W "."

 .I $D(^AUPN3PPH("C",ABMDFN)) S DA=$O(^(ABMDFN,0)) D ^ABMDDIE S ABMC3=ABMC3+1

 I '$D(ZTQUEUED) W !!,?10,"POLICIES CHANGED: ",ABMC1+ABMC3,!

END ;EP

W !

 K DIR S DIR(0)="YO",DIR("A")="Do you wish to Select another Employer" D ^DIR I Y=1 G SEL

XIT K ABMEMP,ABMEMPNM,ABMGRP,ABMGRPNM,ABMC1,ABMC2,ABMC3,ABMDA,ABMDFN,DA

ABMDTGAS  ; IHS/ASDST/DMJ - Remap Group Names for an Employer ;

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

 +2       ;;

 +3       ; this enables the mass changes of group names for all

 +4       ; policies associated with one employer

 +5       ; select Employer to remap

 +6       ; select New Group name

 +7       ; scan all policies for that employer and change the group name

 +8       ; to the one selected

S         ;

 +1        WRITE !!,"This utility allows for the mass assignment of a specified Group Plan to the",!,"policies of each employee for a selected Employer.",!

 +2        KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Do you wish to run this utility program"

 +3        DO ^DIR

           IF '$GET(Y)

               QUIT

SEL       ;--->

           WRITE !

           KILL DIC

           SET DIC="^AUTNEMPL("

           SET DIC(0)="AEQMZ"

           DO ^DIC

           IF Y'>0

               WRITE !,"NONE SELECTED EXITING OPTION",!,*7

               HANG 3

               GOTO XIT

 +1        SET ABMEMP=+Y

           SET ABMEMPNM=Y(0,0)

 +2       ;--->

           WRITE !

           KILL DIC

           SET DIC="^AUTNEGRP("

           SET DIC("A")="Select GROUP PLAN: "

           SET DIC(0)="AEQMZ"

           DO ^DIC

           IF Y'>0

               WRITE *7

               GOTO END

 +3        SET ABMGRP=+Y

           SET ABMGRPNM=Y(0,0)

 +4        WRITE !!,"You have selected to assign all employees of: ",ABMEMPNM

 +5        WRITE !?29," the Group Plan: ",ABMGRPNM

 +6       ;--->

           WRITE !

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Is this Correct (Y/N)"

           DO ^DIR

           IF $DATA(DIRUT)!$DATA(DIROUT)

               GOTO XIT

           IF Y=0

               GOTO END

 +7       ;

SCAN1     ;EP scan "AE" of policy holder file

 +1        SET ABMDA=0

           SET DIE="^AUPN3PPH("

           SET DR=".06////"_ABMGRP

 +2        FOR ABMC1=0:1

               SET ABMDA=$ORDER(^AUPN3PPH("AE",ABMEMP,ABMDA))

               IF 'ABMDA

                   QUIT

               Begin DoDot:1

 +3                IF '$DATA(ZTQUEUED)

                       IF (ABMC1#100)

                           WRITE "."

 +4                SET DA=ABMDA

                   DO ^ABMDDIE

               End DoDot:1

               IF $DATA(ABM("DIE-FAIL"))

                   QUIT

 +5       ;

SCAN2     ;EP scan the patient file to pick up those policies that have

 +1       ;registration links (the employer pointer is not stored in the Policy file

 +2        SET ABMDFN=0

           SET DIE="^AUPN3PPH("

           SET DR=".06////"_ABMGRP

           SET ABMC3=0

 +3        IF $DATA(^AUPNPAT("AF",ABMEMP))

               FOR ABMC2=0:1

                   SET ABMDFN=$ORDER(^AUPNPAT("AF",ABMEMP,ABMDFN))

                   IF 'ABMDFN

                       QUIT

                   Begin DoDot:1

 +4                    IF '$DATA(ZTQUEUED)

                           IF (ABMC2#100)

                               WRITE "."

 +5                    IF $DATA(^AUPN3PPH("C",ABMDFN))

                           SET DA=$ORDER(^(ABMDFN,0))

                           DO ^ABMDDIE

                           SET ABMC3=ABMC3+1

                   End DoDot:1

                   IF $DATA(ABM("DIE-FAIL"))

                       QUIT

 +6       ;

 +7        IF '$DATA(ZTQUEUED)

               WRITE !!,?10,"POLICIES CHANGED: ",ABMC1+ABMC3,!

END       ;EP

 +1        WRITE !

 +2        KILL DIR

           SET DIR(0)="YO"

           SET DIR("A")="Do you wish to Select another Employer"

           DO ^DIR

           IF Y=1

               GOTO SEL

XIT        KILL ABMEMP,ABMEMPNM,ABMGRP,ABMGRPNM,ABMC1,ABMC2,ABMC3,ABMDA,ABMDFN,DA

 +1        QUIT

ABMDTGAS.m