Routine: ABMCHOUS

ABMCHOUS ; IHS/SD/SDR - Setup Clearing House ;

 ;;2.6;IHS 3P BILLING SYSTEM;**6,8**;NOV 12, 2009

START ;start

 W !!

 D ^XBFMK

 S DIC="^ABMRECVR("

 S DIC(0)="AEMQL"

 S DIC("A")="Enter the clearinghouse name: "

 D ^DIC

 Q:Y<0

 Q:$D(DTOUT)!$D(DUOUT)

 S ABMCH=+Y

 D ^XBFMK

 S DIE="^ABMRECVR("

 S DA=ABMCH

 ;S DR=".01//;W !!,""Setting up Header Data... "",!;.02//;.03//"  ;abm*2.6*8 HEAT45044

 S DR=".01//;W !!,""Setting up Header Data... "",!;.02//;.03//;.04//;.05"  ;abm*2.6*8 HEAT45044

 D ^DIE

 I '$D(^ABMRECVR(ABMCH)) K ^ABMRECVR(ABMCH,1),ABMCH

 Q:'$G(ABMCH)

 D ^XBFMK

 W !!

INSURER ;

 F  D  Q:Y<0

 .D ^XBFMK

 .S DIR(0)="PO^9999999.18:EMQ"

 .S DIR("A")="Select Insurer"

 .D ^DIR K DIR

 .Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)

 .I $D(^ABMRECVR("C",+Y)) D  Q

 ..S ABMCHIEN=$O(^ABMRECVR("C",+Y,0))

 ..I ABMCHIEN'=ABMCH D  ;Insurer is set up w/different CH than the one we are editing

 ...W !!,"** Insurer "_$P($G(^AUTNINS(+Y,0)),U)_" is already setup"

 ...W !?3,"with Clearinghouse ",$P($G(^ABMRECVR(ABMCHIEN,0)),U)," and cannot be setup with a second Clearinghouse."

 ...W !!

 ..;I ABMCHIEN=ABMCH D  Q  ;Insurer is set up w/CH we are editing  ;abm*2.6*8

 ..I ABMCHIEN=ABMCH D  ;Insurer is set up w/CH we are editing  ;abm*2.6*8

 ...W !!,"** Insurer "_$P($G(^AUTNINS(+Y,0)),U)_" is already setup"

 ...W !?3,"with this Clearinghouse"

 ...W !!

 ...K DIC,DIE,DIR

 ...S DA(1)=ABMCH

 ...S DA=+Y

 ...S DIE="^ABMRECVR("_DA(1)_",1,"

 ...;S DR=".01//;.02//"  ;abm*2.6*8 HEAT28891

 ...S DR=".01//;.02//;.03//"  ;abm*2.6*8 HEAT28891

 ...D ^DIE

 ...S Y=0

 .S ABM("INS")=+Y

 .D ^XBFMK

 .S DA(1)=ABMCH

 .S DIC="^ABMRECVR("_DA(1)_",1,"

 .S DIC("P")=$P(^DD(9002274.095,1,0),U,2)

 .S DIC(0)="E"

 .S (X,DINUM)=ABM("INS")

 .K DD,DO

 .D FILE^DICN

 .Q:Y<0

 .S DIE="^ABMRECVR("_DA(1)_",1,"

 .S DA=+Y

 .;S DR=".01//;.02//"  ;abm*2.6*8 HEAT28891

 .S DR=".01//;.02//;.03//"  ;abm*2.6*8 HEAT28891

 .D ^DIE

 .S Y=1

ABMCHOUS  ; IHS/SD/SDR - Setup Clearing House ;

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

 +2       ;

START     ;start

 +1        WRITE !!

 +2        DO ^XBFMK

 +3        SET DIC="^ABMRECVR("

 +4        SET DIC(0)="AEMQL"

 +5        SET DIC("A")="Enter the clearinghouse name: "

 +6        DO ^DIC

 +7        IF Y<0

               QUIT

 +8        IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT

 +9        SET ABMCH=+Y

 +10       DO ^XBFMK

 +11       SET DIE="^ABMRECVR("

 +12       SET DA=ABMCH

 +13      ;S DR=".01//;W !!,""Setting up Header Data... "",!;.02//;.03//"  ;abm*2.6*8 HEAT45044

 +14      ;abm*2.6*8 HEAT45044

           SET DR=".01//;W !!,""Setting up Header Data... "",!;.02//;.03//;.04//;.05"

 +15       DO ^DIE

 +16       IF '$DATA(^ABMRECVR(ABMCH))

               KILL ^ABMRECVR(ABMCH,1),ABMCH

 +17       IF '$GET(ABMCH)

               QUIT

 +18       DO ^XBFMK

 +19       WRITE !!

INSURER   ;

 +1        FOR

               Begin DoDot:1

 +2                DO ^XBFMK

 +3                SET DIR(0)="PO^9999999.18:EMQ"

 +4                SET DIR("A")="Select Insurer"

 +5                DO ^DIR

                   KILL DIR

 +6                IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)

                       QUIT

 +7                IF $DATA(^ABMRECVR("C",+Y))

                       Begin DoDot:2

 +8                        SET ABMCHIEN=$ORDER(^ABMRECVR("C",+Y,0))

 +9       ;Insurer is set up w/different CH than the one we are editing

                           IF ABMCHIEN'=ABMCH

                               Begin DoDot:3

 +10                               WRITE !!,"** Insurer "_$PIECE($GET(^AUTNINS(+Y,0)),U)_" is already setup"

 +11                               WRITE !?3,"with Clearinghouse ",$PIECE($GET(^ABMRECVR(ABMCHIEN,0)),U)," and cannot be setup with a second Clearinghouse."

 +12                               WRITE !!

                               End DoDot:3

 +13      ;I ABMCHIEN=ABMCH D  Q  ;Insurer is set up w/CH we are editing  ;abm*2.6*8

 +14      ;Insurer is set up w/CH we are editing  ;abm*2.6*8

                           IF ABMCHIEN=ABMCH

                               Begin DoDot:3

 +15                               WRITE !!,"** Insurer "_$PIECE($GET(^AUTNINS(+Y,0)),U)_" is already setup"

 +16                               WRITE !?3,"with this Clearinghouse"

 +17                               WRITE !!

 +18                               KILL DIC,DIE,DIR

 +19                               SET DA(1)=ABMCH

 +20                               SET DA=+Y

 +21                               SET DIE="^ABMRECVR("_DA(1)_",1,"

 +22      ;S DR=".01//;.02//"  ;abm*2.6*8 HEAT28891

 +23      ;abm*2.6*8 HEAT28891

                                   SET DR=".01//;.02//;.03//"

 +24                               DO ^DIE

 +25                               SET Y=0

                               End DoDot:3

                       End DoDot:2

                       QUIT

 +26               SET ABM("INS")=+Y

 +27               DO ^XBFMK

 +28               SET DA(1)=ABMCH

 +29               SET DIC="^ABMRECVR("_DA(1)_",1,"

 +30               SET DIC("P")=$PIECE(^DD(9002274.095,1,0),U,2)

 +31               SET DIC(0)="E"

 +32               SET (X,DINUM)=ABM("INS")

 +33               KILL DD,DO

 +34               DO FILE^DICN

 +35               IF Y<0

                       QUIT

 +36               SET DIE="^ABMRECVR("_DA(1)_",1,"

 +37               SET DA=+Y

 +38      ;S DR=".01//;.02//"  ;abm*2.6*8 HEAT28891

 +39      ;abm*2.6*8 HEAT28891

                   SET DR=".01//;.02//;.03//"

 +40               DO ^DIE

 +41               SET Y=1

               End DoDot:1

               IF Y<0

                   QUIT

 +42       QUIT

ABMCHOUS.m