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

AGEL0.m

Go to the documentation of this file. 
  1. AGEL0 ; IHS/ASDS/EFG - Add/Edit Eligibility Information ;   
  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. DISP ;EP - DISP FLDS
  1.  ;Q:'$D(AGELP("PH"))!(DFN="")
  1.  Q:'$D(AGELP("PH"))!($G(DFN)="")  ;IHS/SD/TPF AG*7.1*1 9/6/2005
  1.  D ^AGELA    ;DISP FLDS
  1.  I $D(AGSEENLY) D ^DIR,READ^AGED1 G XIT
  1. ACTION ;
  1.  D OPT^AGEL0A
  1.  G XIT:$G(AGELP("PH"))=""
  1.  ;AFTER EDITING THE SELECTION MUST BE UPDATED SO ANY ERRORS
  1.  ;CORRECTED WILL BE REFLECTED ON THE REDRAWN SCREEN
  1.  S:$G(AGSELECT)'="" AGSELECT=$$FINDPVT^AGINSUPD(AGSELECT)
  1.  I ($D(MYERRS("C","E"))&(Y'?1N.N))&(Y'=AGOPT("ESCAPE")),(Y'["V"),(Y'["E"),(Y'["A"),(Y'["D") W !,"ERRORS ON THIS PAGE. PLEASE FIX BEFORE EXITING!!" H 3 G DISP
  1.  Q:$G(Y)=AGOPT("ESCAPE")
  1.  G XIT:$D(DIROUT)!(Y="N")!$D(DUOUT)!$D(DTOUT) G DISP:Y["V"
  1.  I Y="A",$P(^AUPN3PPH(AGELP("PH"),0),U,5)]"",$D(^AUTTPIC($P(^(0),U,5),0)),$P(^(0),U,4)="S" W !!?5,*7,"The COVERAGE TYPE for this Policy is for SELF ONLY, thus no members"
  1.  I  W !?5,"may be added! Change the Coverage Type if it is incorrect!" H 5 G DISP
  1.  ;I Y="A" S TEMPDFN=DFN S AGEL("LBL")=$S($P(^AUTNINS(AGELP("INS"),2),U)="D":"D14^AGEL2",1:"V14^AGEL3") D @AGEL("LBL") S (AUPNPAT,DFN)=TEMPDFN G DISP
  1.  I Y="A" S TEMPDFN=DFN S AGEL("LBL")=$S($$INSTYP^AGUTL(AGELP("INS"))="D":"D14^AGEL2",1:"V14^AGEL3") D @AGEL("LBL") S (AUPNPAT,DFN)=TEMPDFN G DISP  ;IHS/OIT/NKD AG*7.1*12
  1.  I Y="D" D DEL^AGEL0A G XIT:'$D(AGELP("PH")),DISP
  1. EDIT ;Entry of Claim Identifiers
  1.  S AGELP("MODE")="E"  ;IF THIS TAG ENTERED THEN WE ARE IN EDIT MODE
  1.  D FLDS^AGEL0A
  1.  G XIT:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!$D(DTOUT)
  1.  W !!
  1. EDLOOP ;EP - LOOP ASKING FOR FIELD INPUT
  1.  ;THIS LOOP ENTERS WITH DA SET TO THE POLICY HOLDER PTR
  1.  S DR="" F AGEL("I")=1:1 S AGEL=$P(AGELP("FLDS"),",",AGEL("I")) Q:AGEL=""!$D(DUOUT)!$D(DTOUT)  D
  1.  .S AGEL("TYP")="H"
  1.  .I AGEL=1 D ^AGELPHCK Q
  1.  .I AGEL=5 D PHSEX^AGEL4 Q
  1.  .I AGEL=6 D PHDOB^AGEL4 Q
  1.  .I AGEL=7 D PCP^AGEL4 Q
  1.  .I AGEL=8 D ESTAT^AGEL4 Q
  1.  .I AGEL=9 D EMP^AGEL4 Q
  1.  .I AGEL=10 D GRP^AGEL4 Q
  1.  .I AGEL=11 D COV^AGEL4 Q
  1.  .I AGEL=12 D CARDCOPY^AGEL4 Q
  1.  .I AGEL>7&(AGEL<10) D
  1.  ..S AGEL("TYP")=$S($P(^AUPN3PPH(AGELP("PH"),0),U,2)]"":"P",1:"H")
  1.  .I '$D(AGELP("PHPAT")),$P(^AUPN3PPH(AGELP("PH"),0),U,2)]"" S AGELP("PHPAT")=$P(^(0),U,2)
  1.  .I AGEL>9,AGEL<11,AGELP("TYPE")="MCD" Q
  1.  .E  K DIE("NO^")
  1.  .I AGEL=8 D
  1.  ..S AGEL("TYP")=$S($P(^AUPN3PPH(AGELP("PH"),0),U,2)]"":"S",1:"H")
  1.  .I AGEL=9 S AGEL("D")=AGEL("TYP")_14_"^AGEL4" D @AGEL("D") Q
  1.  .I AGEL>12 D
  1.  ..;S AGEL("TYP")=$S($P(^AUTNINS(AGELP("INS"),2),U)="D":"D",1:"V")
  1.  ..S AGEL("TYP")=$S($$INSTYP^AGUTL(AGELP("INS"))="D":"D",1:"V")  ;IHS/OIT/NKD AG*7.1*12
  1.  ..S AGEL("D")=AGEL("TYP")_14_"^AGEL5" D @AGEL("D") Q
  1.  .S AGEL("T")=AGEL
  1.  .S DR=$P($T(@(AGEL("TYP")_AGEL("T"))),";;",2)
  1.  .S DIE=$S(AGEL("TYP")="H":"^AUPN3PPH(",AGEL("TYP")="P":"^DPT(",AGEL("TYP")="D":"^AUPNMCD(",AGEL("TYP")="S":"^AUPNPAT(",1:"^AUPNPRVT(")
  1.  .S DA=$S(AGEL("TYP")="H":$G(AGELP("PH")),AGEL("TYP")="D":$G(AGELP("MCD")),AGEL("TYP")="V":$G(AGELP("PI")),1:$G(AGELP("PHPAT")))
  1.  .;IF THE USER CHOOSES 2 OR 3 THIS SHOULD BE THE PRIVATE INSURANCE FILE NOT POLICY HOLDER FILE 
  1.  .I AGEL=2!(AGEL=3) S DIE("NO^")=""
  1.  .;I AGEL=3!(AGEL=4) D  Q
  1.  .;.M TEMPDR=DR,TEMPDIE=DIE,TEMPDIC=DIC
  1.  .;.K DIR,DR,DIE,DIC
  1.  .;.I AGEL=3 S DIE("NO^")=""
  1.  .;.S DR=$S(AGEL=3:".06R",1:".07")
  1.  .;.S PRVTIEN=$P(AGINSREC,U,11)
  1.  .;.S DA(1)=$P(PRVTIEN,",")
  1.  .;.S DA=$P(PRVTIEN,",",3)
  1.  .;.S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  .;.D ^DIE
  1.  .;.K DIR,DR,DIE,DIC
  1.  .;.M DR=TEMPDR K TEMPDR
  1.  .;.M DIC=TEMPDIC K TEMPDIC
  1.  .;.M DIE=TEMPDIE K TEMPDIE
  1.  .Q:$G(DA)=""
  1.  .D ^DIE
  1.  K %DT
  1.  Q:AGELP("MODE")="A"
  1.  ;AFTER EDITING THE SELECTION MUST BE UPDATED SO ANY ERRORS
  1.  ;CORRECTED WILL BE REFLECTED ON THE REDRAWN SCREEN
  1.  S:$G(AGSELECT)'="" AGSELECT=$$FINDPVT^AGINSUPD(AGSELECT)
  1.  D UPDT^AGEL5
  1.  G DISP
  1. H1 ;;.01R~[1] Name on Policy..: 
  1. H2 ;;.04R~[2] Policy or SSN...:
  1. H3 ;;.17R~[3] Effective Date..: 
  1. H4 ;;.18[4] Expiration Date.:
  1. H11 ;;.08R~[11] Sex of Insured..: 
  1. P11 ;;W !,"** Patient Registraion Data (SEX) is Uneditable **"
  1. H12 ;;.19[12] DOB of Insured..: 
  1. P12 ;;W !,"** Patient Registraion Data (DOB) is Uneditable **"
  1. H9 ;;W !;W "<--------------INSURED'S ADDRESS-------------->";.09[9a] Street...: ;I X="" S Y="@9";.11[9b] City.....: ;.12[9c] State....: ;.13[9d] Zip......: ;W !;@9
  1. P9 ;;W !;W "<--------------INSURED'S ADDRESS-------------->";.111[9a] Street...: ;I X="" S Y="@9";.114[9b] City.....: ;.115[9c] State....: ;.116[9d] Zip......: ;W !;@9
  1. H10 ;;.14[10] Phone.....: 
  1. P10 ;;.131[10] Phone.....: 
  1. H13 ;;.15[13] Empl Stat.: 
  1. S13 ;;.21[13] Empl Stat.: 
  1.  ;
  1. XIT Q