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

AGELA.m

Go to the documentation of this file. 
  1. AGELA ; IHS/ASDS/EFG - Add/Edit Eligibility Display ;  
  1.  ;;7.1;PATIENT REGISTRATION;**11,12**;AUG 25,2005;Build 1
  1.  ;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX
  1.  ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
  1.  ;
  1.  ;ALLOW PROPER EXIT FROM PRIVATE SCREEN AFTER DELETING ENTRY
  1.  Q:$G(AGELP("PH"))=""
  1.  I '$D(^AUPN3PPH(AGELP("PH"))) D
  1.  .S $P(^AUPN3PPH(AGELP("PH"),0),U)="VALIDATE"
  1.  .S $P(^AUPN3PPH(AGELP("PH"),0),U,2)=$G(AGELP("PI"))
  1.  .S $P(^AUPN3PPH(AGELP("PH"),0),U,3)=$G(AGELP("INS"))
  1.  S AGV("X2")=AGELP("PH")_";"_$P(^AUPN3PPH(AGELP("PH"),0),U)
  1.  S AGV("X3")=""
  1.  D ^AGELE2X2
  1.  K AGE
  1.  I $P(^AUPN3PPH(AGELP("PH"),0),U,2)]"" S AGELP("PHPAT")=$P(^(0),U,2)
  1.  E  I $P(^AUPN3PPH(AGELP("PH"),0),U,16)]"" S AGELP("EMPL")=$P(^(0),U,16)
  1.  I '$D(IOF) D HOME^%ZIS
  1.  ;header
  1. HDR W $$S^AGVDF("IOF")
  1.  S AG("PG")="4PVTA"
  1.  S ROUTID=$P($T(+1)," ")
  1.  D PROGVIEW^AGUTILS(DUZ)
  1.  W !
  1.  W "IHS REGISTRATION ",$S($D(AGSEENLY):"VIEW SCREEN",1:"EDITOR")
  1.  W ?33,"Private Insurance"
  1.  W ?80-$L($P(^DIC(4,DUZ(2),0),U)),$P(^DIC(4,DUZ(2),0),U)
  1.  S AGLINE("-")=$TR($J(" ",80)," ","-")
  1.  S AGLINE("EQ")=$TR($J(" ",80)," ","=")
  1.  W !,AGLINE("EQ")
  1.  I $G(AGPAT)'="" W !,$E(AGPAT,1,23)
  1.  E  W !,$E($P($G(^DPT(DFN,0)),U),1,23)
  1.  I $G(AGUPDT)'="" W ?23,AGUPDT
  1.  I $G(AGCHRT)'="" W ?42,"HRN#:",AGCHRT
  1.  E  W ?42,"HRN#:",$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
  1.  S AGELSTS=$P($G(^AUPNPAT(DFN,11)),U,12)
  1.  W ?56,"(",$S(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PENDING VERIFICATION",1:"NONE"),")"
  1.  W !,AGLINE("EQ")
  1.  K DR,DIE,AG("ED"),AGDTS
  1. DATA W !,"1) Policy Holder.: ",$E($P(^AUPN3PPH(AGELP("PH"),0),U),1,20) S AGEL("P")=$P(^(0),U,2)
  1.  I AGEL("P")]"",'$D(^DPT(AGEL("P"),0)) S AGEL("P")=""
  1.  I AGEL("P")="" W " [NOT REG]"
  1.  ;IHS/OIT/NKD AG*7.1*11 MU2 - STANDARDIZED DISPLAY OF GENDER - START NEW CODE
  1.  ;W ?50,"|5)  Gender (M/F): "
  1.  ;W $S($P(AGV("X2"),U,6)="M":"MALE",$P(AGV("X2"),U,6)="F":"FEMALE",1:"")
  1.  W ?50,"|5)  Gender: "
  1.  W $S($P(AGV("X2"),U,6)="M":"MALE",$P(AGV("X2"),U,6)="F":"FEMALE",$P(AGV("X2"),U,6)="U":"UNKNOWN",1:"")
  1.  ;IHS/OIT/NKD AG*7.1*11 END NEW CODE
  1.  W !,"2) Policy or SSN.: ",$P(^AUPN3PPH(AGELP("PH"),0),U,4)
  1.  W ?50,"|6)  Date of Birth: "
  1.  S AGEL("DT")=$P(AGV("X2"),U,7)
  1.  D DT
  1.  W AGEL("DT")
  1.  W !,"3) Effective Date: "
  1.  S AGEL("DT")=$P(^AUPN3PPH(AGELP("PH"),0),U,17)
  1.  D DT
  1.  W AGEL("DT")
  1.  W ?50,"|7) Prim care Prov: "
  1.  K PRVTNODE
  1.  I $G(AGSELECT)'="" S PRVTNODE=$P($G(AGSELECT),U,11),PRVTNODE="^AUPNPRVT("_PRVTNODE_")"
  1.  E  I $G(AGREC)'="" S PRVTNODE="^AUPNPRVT("_DFN_",11,"_AGREC_",0)"
  1.  I $G(PRVTNODE)'="" W $P($G(@PRVTNODE),U,14)
  1.  K PRVTNODE
  1.  W !,"4) Expire Date...: "
  1.  S AGEL("DT")=$P(^AUPN3PPH(AGELP("PH"),0),U,18)
  1.  D DT
  1.  W AGEL("DT")
  1.  W ?55,$$GET1^DIQ(9000006.11,$G(AGELP("INS"))_","_DFN_",",.14)
  1.  W !,"-HOLDER'S EMPLOYER INFO---------------------------------------------------------"
  1.  W !,"8) Status........: "
  1.  W $$GET1^DIQ(9000003.1,AGELP("PH"),.15)
  1.  W ?40,"| 9) Employer: "
  1.  W $$GET1^DIQ(9000003.1,AGELP("PH"),.16)
  1.  W !,"-INSURER INFORMATION-----------------------------------------------------------"
  1.  N AGINS
  1.  S AGINS=$S(AGELP("INS")'="":$G(^AUTNINS(AGELP("INS"),0)),1:"")
  1.  W !,$P(AGINS,U)   ;insurer name
  1.  W ?40,"|10)  Grp Name: "
  1.  I $P(^AUPN3PPH(AGELP("PH"),0),U,6)]"" D
  1.  .S AGEL("EGRP")=$P(^AUPN3PPH(AGELP("PH"),0),U,6)
  1.  .I $D(^AUTNEGRP(AGEL("EGRP"),0)) W $E($P(^(0),U),1,17)
  1.  E  K AGEL("EGRP")
  1.  W !?2,$P(AGINS,U,2)
  1.  W ?40,"|     Grp Number: "
  1.  I $D(AGEL("EGRP")),AGEL("EGRP")]"",$D(^AUTNEGRP(AGEL("EGRP"),0)) D
  1.  .W $E($S(+$O(^AUTNEGRP(AGEL("EGRP"),11,0)):"(Visit Specific)",1:$P(^AUTNEGRP(AGEL("EGRP"),0),U,2)),1,17)
  1.  W !?2,$P(AGINS,U,3)_", "        ;insurer city
  1.  I $P(AGINS,U,4)'=""  D
  1.  . W $P($G(^DIC(5,$P(AGINS,U,4),0)),U,2)_"  "   ;insurer state
  1.  E  W "  "
  1.  W $P(AGINS,U,5)                 ;insurer zip
  1.  W ?40,"|11)  Coverage: "
  1.  I $P($G(^AUPN3PPH(AGELP("PH"),0)),U,5)]"",$D(^AUTTPIC($P(^(0),U,5),0)) W $E($P(^(0),U),1,17)
  1.  W !?2,$P(AGINS,U,6)             ;insurer phone
  1.  W ?23,"Ins. Type: "
  1.  ;W:$G(AGELP("INS"))'="" $P($G(^AUTNINS(AGELP("INS"),2)),U)
  1.  W:$G(AGELP("INS"))'="" $$INSTYP^AGUTL(AGELP("INS"))  ;IHS/OIT/NKD AG*7.1*12
  1.  I '$G(AGEL("IN")) S AGEL("IN")=$G(AGELP("INS"))
  1.  S AGPRVIN0=$G(^AUPNPRVT(DFN,11,AGEL("IN"),0))
  1.  W ?40,"|12)  CCopy: "
  1.  W $P(AGPRVIN0,U,15)
  1.  I $P($G(^AUPNPRVT(DFN,11,AGEL("IN"),0)),U,15)'="",$P($G(^AUPNPRVT(DFN,11,AGEL("IN"),0)),U,15)'="N" D
  1.  .W ?62,"Date: "
  1.  .S AGEL("DT")=$P(AGPRVIN0,U,16)
  1.  .D DT
  1.  .W AGEL("DT")
  1. PHADD ;
  1. E0 ;
  1. E1 ;
  1. E2 ;
  1. MEM W !,"----Policy Members----PC-----Member #------HRN-----"
  1.  W "Rel----------From/Thru-------"
  1.  Q:$G(AGELP("INS"))=""
  1.  ;S AGEL("DIC")=$S($P(^AUTNINS(AGELP("INS"),2),U)="D":"MCD",1:"PRVT")_"^AGELA1"
  1.  S AGEL("DIC")=$S($$INSTYP^AGUTL(AGELP("INS"))="D":"MCD",1:"PRVT")_"^AGELA1"  ;IHS/OIT/NKD AG*7.1*12
  1.  D @AGEL("DIC")
  1.  S AGELP("FLDS")=AGEL("I")+11
  1.  W !
  1.  F J=1:1:80 W "="
  1.  K MYERRS,MYVARS
  1.  D FETCHERR^AGEDERR(AG("PG"),.MYERRS)
  1.  S MYVARS("DFN")=DFN,MYVARS("FINDCALL")="FINDPVT",MYVARS("SELECTION")=$G(AGSELECT),MYVARS("SITE")=DUZ(2)
  1.  D EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
  1.  W !,$G(AGLINE("-"))
  1.  D VERIF^AGUTILS
  1.  W !,$G(AGLINE("EQ"))
  1. XIT ;
  1.  K ROUTID
  1.  Q
  1. DT ;
  1.  I AGEL("DT")]"" S AGEL("DT")=$$FMTE^XLFDT(AGEL("DT"),5)
  1.  Q