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

AGEL5.m

Go to the documentation of this file.
  1. AGEL5 ; IHS/ASDS/EFG - Add/Edit Eligibility PART 5 ;
  1. ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
  1. ;
  1. V14 S (AGEL("HIT"),AGEL("PT"))=0 F AGZ("I")=1:1 S AGEL("PT")=$O(AGELP(AGEL("PT"))) Q:'+AGEL("PT") I +AGELP(AGEL("PT"))=AGEL S AGEL("HIT")=AGEL("PT") Q
  1. I AGEL("HIT") W !!,"Policy Member: ",$P(^DPT(AGEL("PT"),0),U)
  1. Q:'AGEL("HIT")
  1. NEW AGBILL
  1. S AGBILL=$$USED^AGED51(AGEL("PT"),"",8,+$P(AGELP(AGEL("HIT")),U,2))
  1. I $L(AGBILL) S X="IORVON;IORVOFF" D ENDR^%ZISS,HELP^XBHELP("USED","AGED51"),KILL^%ZISS
  1. I $L(AGBILL) Q:'$$DIR^XBDIR("Y","Proceed with edit of Date Record","N")
  1. I AGEL("HIT")
  1. I S DA(1)=AGEL("HIT"),DIE="^AUPNPRVT("_DA(1)_",11,",DA=+$P(AGELP(AGEL("HIT")),U,2),DR=".05R~Relationship to Insured..: ;.06Starting Date.. : ;.07Expiration Date...: ;.12Person Code...: ;21Member Number: " D ^DIE
  1. Q
  1. D14 S (AGEL("HIT"),AGEL("PT"))=0
  1. F AGZ("I")=1:1 S AGEL("PT")=$O(AGELP(AGEL("PT"))) Q:'+AGEL("PT") I +AGELP(AGEL("PT"))=AGEL S AGEL("HIT")=AGELP(AGEL("PT")) Q
  1. Q:AGEL("HIT")=0
  1. W !!,"Policy Member: ",$P(^DPT(AGEL("PT"),0),U)
  1. S DA=$P(AGEL("HIT"),U,2)
  1. S DIE="^AUPNMCD(",DR=".06R~Relationship to Insured..: "
  1. D ^DIE
  1. I '$D(^AUPNMCD(DA,11)) S ^AUPNMCD(DA,11,0)="^9000004.11D^^"
  1. S DA(1)=$P(AGEL("HIT"),U,2)
  1. S DIE="^AUPNMCD("_DA(1)_",11,"
  1. S DA=$P(AGEL("HIT"),U,3)
  1. S DR=".02Expiration Date..: "
  1. I DA]"" D ^DIE Q
  1. K DIC
  1. S DIC(0)="QEAL",DIC=DIE,DIC("DR")=".02Expiration Date..: "
  1. S DIC("A")=" Effective Date...: "
  1. D ^DIC
  1. K DIC
  1. Q
  1. UPDT ;EP - UPDATE FLDS IN ELIGIBILITY FILE
  1. S AGEL("U0")=^AUPN3PPH(AGELP("PH"),0),AGEL("U")=""
  1. G:AGELP("TYPE")="MCD" UMCD
  1. F AGZ("I")=1:1 S AGEL("U")=$O(^AUPNPRVT("C",AGELP("PH"),AGEL("U"))) Q:'+AGEL("U") D
  1. .S AGEL("U1")=""
  1. .F AGZ("I")=1:1 S AGEL("U1")=$O(^AUPNPRVT("C",AGELP("PH"),AGEL("U"),AGEL("U1"))) Q:'+AGEL("U1") D
  1. ..S DR=".02////"_$P(AGEL("U0"),U,4)_";.03////"_$P(AGEL("U0"),U,5)_";.04////"_$P(AGEL("U0"),U)
  1. ..S AGX0=^AUPNPRVT(AGEL("U"),11,AGEL("U1"),0)
  1. ..S AGEL("U0BD")=$P(AGEL("U0"),U,17),AGEL("U0ED")=$P(AGEL("U0"),U,18)
  1. ..S AGEL("X0BD")=$P(AGX0,U,6),AGEL("X0ED")=$P(AGX0,U,7)
  1. ..I (AGEL("X0BD")<AGEL("U0BD")) S DR=DR_";.06////"_AGEL("U0BD")
  1. ..I AGEL("U0ED"),(AGEL("X0BD")>AGEL("U0ED")) D
  1. ...S DR=DR_";.06////"_AGEL("U0BD")
  1. ..I AGEL("X0ED"),(AGEL("X0BD")'<AGEL("X0ED")) D
  1. ...S DR=DR_";.06////"_AGEL("U0BD")
  1. ..I AGEL("U0ED"),(AGEL("X0ED")>AGEL("U0ED")) D
  1. ...S DR=DR_";.07////"_AGEL("U0ED")
  1. ..I AGEL("U0ED"),'AGEL("X0ED") S DR=DR_";.07////"_AGEL("U0ED")
  1. ..I AGEL("X0ED"),(AGEL("X0ED")<AGEL("U0BD")) D
  1. ...S DR=DR_";.07////"_AGEL("U0ED")
  1. ..I AGEL("X0ED"),(AGEL("X0ED")'>AGEL("X0BD")) D
  1. ...S DR=DR_";.07////"_AGEL("U0ED")
  1. ..I ($P(AGX0,U,5)=25) D
  1. ...S DR=DR_";.06////"_AGEL("U0BD")_";.07////"_AGEL("U0ED") ;self
  1. ..S DA(1)=AGEL("U"),DIE="^AUPNPRVT("_DA(1)_",11,",DA=AGEL("U1") D ^DIE
  1. ..S AGEL("DFN")=$S($D(DFN):DFN,1:""),DFN=DA("1")
  1. ..D UPDATE^AGED
  1. ..S:AGEL("DFN")]"" DFN=AGEL("DFN")
  1. ..K AGX0,AGEL("U0BD"),AGEL("U0ED"),AGEL("X0BD"),AGEL("X0ED")
  1. Q
  1. UMCD F AGZ("I")=1:1 S AGEL("U")=$O(^AUPNMCD("C",AGELP("PH"),AGEL("U"))) Q:'+AGEL("U") D
  1. .S DR=".03////"_$P(AGEL("U0"),U,4)_";.05////"_$P(AGEL("U0"),U)
  1. .S DIE="^AUPNMCD(",DA=AGEL("U") D ^DIE
  1. .S AGEL("COV")=$P(AGEL("U0"),U,5),AGEL("X")=AGEL("U") D DEDML^AGEL2
  1. .S AGEL("DFN")=$S($D(DFN):DFN,1:"")
  1. .S AGEL("MCD")=$S($D(AG("MCD")):AG("MCD"),1:"")
  1. .S DFN=$P(^AUPNMCD(AGEL("U"),0),U)
  1. .S AG("MCD")=AGEL("U")
  1. .D UPDATE^AGED5
  1. .S:AGEL("DFN")]"" DFN=AGEL("DFN")
  1. .S:AGEL("MCD")]"" AG("MCD")=AGEL("MCD")
  1. Q