AGTMCOV.m

AGTMCOV ; IHS/ASDS/EFG - Table Maintenance of COVERAGE TYPES ; 

 ;;7.1;PATIENT REGISTRATION;**1,2,12**;AUG 25, 2005;Build 1

 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE

 ;

 K DUOUT,DTOUT  ;AG*7.1*1 IHS/SD/TPF 3/1/2006 ALPHA PATCH 1 ISSUE

 S U="^"

 W !

INS K DR,DIE,DIR,DIC,D0,DD  ;AG*7.1*1 IHS/SD/TPF 3/1/2006 ALPHA PATCH 1 ISSUE

 W !! K DIC S DIC="^AUTNINS(",DIC("S")="I $P(^(1),U,7)'=0",DIC("A")="Select INSURER: ",DIC(0)="QEAM" D ^DIC K DIC

 G XIT:X=""!$D(DUOUT)!$D(DTOUT)

 I +Y<1 G INS

 S AG("INS")=+Y

 ;S:$G(AG("INS"))'="" AGINSTYP=$P($G(^AUTNINS(AG("INS"),2)),U)

 S:$G(AG("INS"))'="" AGINSTYP=$$INSTYP^AGUTL(AG("INS"))  ;IHS/OIT/NKD AG*7.1*12

EDIT W !! K DIC S DIC="^AUTTPIC(",DIC("A")="Select COVERAGE TYPE to Edit: ",DIC(0)="QEALM",DIC("S")="I $P(^(0),U,2)=AG(""INS"")",DIC("DR")=".02////"_AG("INS") D ^DIC K DIC

 G XIT:X=""!$D(DUOUT)!$D(DTOUT)

 I +Y<1 G EDIT

 K DR,DIE,DIR,DIC,D0,DD

 S DA=+Y

 S DIE="^AUTTPIC(",DR="W !;.03;.04;.06;11;13;15;17;19"

 S AGCOVNAM=$P($G(^AUTTPIC(DA,0)),U)

 S DR(2,9999999.6519)=".01;.02;.03;.04;.05;.06;.07;.08;.09;.11;.12;.13;.14"

 I $G(AGINSTYP)="R" D

 .I AGCOVNAM="PART A" S DR(2,9999999.6519)=".01;.15;.16;.17;.18;.19"

 .I AGCOVNAM="PART B" S DR(2,9999999.6519)=".01;.21;.22"

 D ^DIE K DR G XIT:$D(Y)

 G INS

XIT K AG,DIR,DIC,DIE,DR

 Q

AGTMCOV   ; IHS/ASDS/EFG - Table Maintenance of COVERAGE TYPES ; 

 +1       ;;7.1;PATIENT REGISTRATION;**1,2,12**;AUG 25, 2005;Build 1

 +2       ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE

 +3       ;

 +4       ;AG*7.1*1 IHS/SD/TPF 3/1/2006 ALPHA PATCH 1 ISSUE

           KILL DUOUT,DTOUT

 +5        SET U="^"

 +6        WRITE !

INS       ;AG*7.1*1 IHS/SD/TPF 3/1/2006 ALPHA PATCH 1 ISSUE

           KILL DR,DIE,DIR,DIC,D0,DD

 +1        WRITE !!

           KILL DIC

           SET DIC="^AUTNINS("

           SET DIC("S")="I $P(^(1),U,7)'=0"

           SET DIC("A")="Select INSURER: "

           SET DIC(0)="QEAM"

           DO ^DIC

           KILL DIC

 +2        IF X=""!$DATA(DUOUT)!$DATA(DTOUT)

               GOTO XIT

 +3        IF +Y<1

               GOTO INS

 +4        SET AG("INS")=+Y

 +5       ;S:$G(AG("INS"))'="" AGINSTYP=$P($G(^AUTNINS(AG("INS"),2)),U)

 +6       ;IHS/OIT/NKD AG*7.1*12

           IF $GET(AG("INS"))'=""

               SET AGINSTYP=$$INSTYP^AGUTL(AG("INS"))

EDIT       WRITE !!

           KILL DIC

           SET DIC="^AUTTPIC("

           SET DIC("A")="Select COVERAGE TYPE to Edit: "

           SET DIC(0)="QEALM"

           SET DIC("S")="I $P(^(0),U,2)=AG(""INS"")"

           SET DIC("DR")=".02////"_AG("INS")

           DO ^DIC

           KILL DIC

 +1        IF X=""!$DATA(DUOUT)!$DATA(DTOUT)

               GOTO XIT

 +2        IF +Y<1

               GOTO EDIT

 +3        KILL DR,DIE,DIR,DIC,D0,DD

 +4        SET DA=+Y

 +5        SET DIE="^AUTTPIC("

           SET DR="W !;.03;.04;.06;11;13;15;17;19"

 +6        SET AGCOVNAM=$PIECE($GET(^AUTTPIC(DA,0)),U)

 +7        SET DR(2,9999999.6519)=".01;.02;.03;.04;.05;.06;.07;.08;.09;.11;.12;.13;.14"

 +8        IF $GET(AGINSTYP)="R"

               Begin DoDot:1

 +9                IF AGCOVNAM="PART A"

                       SET DR(2,9999999.6519)=".01;.15;.16;.17;.18;.19"

 +10               IF AGCOVNAM="PART B"

                       SET DR(2,9999999.6519)=".01;.21;.22"

               End DoDot:1

 +11       DO ^DIE

           KILL DR

           IF $DATA(Y)

               GOTO XIT

 +12       GOTO INS

XIT        KILL AG,DIR,DIC,DIE,DR

 +1        QUIT