- 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