Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGTMCOV

AGTMCOV.m

Go to the documentation of this file.
  1. AGTMCOV ; IHS/ASDS/EFG - Table Maintenance of COVERAGE TYPES ;
  1. ;;7.1;PATIENT REGISTRATION;**1,2,12**;AUG 25, 2005;Build 1
  1. ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
  1. ;
  1. K DUOUT,DTOUT ;AG*7.1*1 IHS/SD/TPF 3/1/2006 ALPHA PATCH 1 ISSUE
  1. S U="^"
  1. W !
  1. INS K DR,DIE,DIR,DIC,D0,DD ;AG*7.1*1 IHS/SD/TPF 3/1/2006 ALPHA PATCH 1 ISSUE
  1. 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
  1. G XIT:X=""!$D(DUOUT)!$D(DTOUT)
  1. I +Y<1 G INS
  1. S AG("INS")=+Y
  1. ;S:$G(AG("INS"))'="" AGINSTYP=$P($G(^AUTNINS(AG("INS"),2)),U)
  1. S:$G(AG("INS"))'="" AGINSTYP=$$INSTYP^AGUTL(AG("INS")) ;IHS/OIT/NKD AG*7.1*12
  1. 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
  1. G XIT:X=""!$D(DUOUT)!$D(DTOUT)
  1. I +Y<1 G EDIT
  1. K DR,DIE,DIR,DIC,D0,DD
  1. S DA=+Y
  1. S DIE="^AUTTPIC(",DR="W !;.03;.04;.06;11;13;15;17;19"
  1. S AGCOVNAM=$P($G(^AUTTPIC(DA,0)),U)
  1. S DR(2,9999999.6519)=".01;.02;.03;.04;.05;.06;.07;.08;.09;.11;.12;.13;.14"
  1. I $G(AGINSTYP)="R" D
  1. .I AGCOVNAM="PART A" S DR(2,9999999.6519)=".01;.15;.16;.17;.18;.19"
  1. .I AGCOVNAM="PART B" S DR(2,9999999.6519)=".01;.21;.22"
  1. D ^DIE K DR G XIT:$D(Y)
  1. G INS
  1. XIT K AG,DIR,DIC,DIE,DR
  1. Q