AGEL5 ; IHS/ASDS/EFG - Add/Edit Eligibility PART 5 ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
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
I AGEL("HIT") W !!,"Policy Member: ",$P(^DPT(AGEL("PT"),0),U)
Q:'AGEL("HIT")
NEW AGBILL
S AGBILL=$$USED^AGED51(AGEL("PT"),"",8,+$P(AGELP(AGEL("HIT")),U,2))
I $L(AGBILL) S X="IORVON;IORVOFF" D ENDR^%ZISS,HELP^XBHELP("USED","AGED51"),KILL^%ZISS
I $L(AGBILL) Q:'$$DIR^XBDIR("Y","Proceed with edit of Date Record","N")
I AGEL("HIT")
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
Q
D14 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")=AGELP(AGEL("PT")) Q
Q:AGEL("HIT")=0
W !!,"Policy Member: ",$P(^DPT(AGEL("PT"),0),U)
S DA=$P(AGEL("HIT"),U,2)
S DIE="^AUPNMCD(",DR=".06R~Relationship to Insured..: "
D ^DIE
I '$D(^AUPNMCD(DA,11)) S ^AUPNMCD(DA,11,0)="^9000004.11D^^"
S DA(1)=$P(AGEL("HIT"),U,2)
S DIE="^AUPNMCD("_DA(1)_",11,"
S DA=$P(AGEL("HIT"),U,3)
S DR=".02Expiration Date..: "
I DA]"" D ^DIE Q
K DIC
S DIC(0)="QEAL",DIC=DIE,DIC("DR")=".02Expiration Date..: "
S DIC("A")=" Effective Date...: "
D ^DIC
K DIC
Q
UPDT ;EP - UPDATE FLDS IN ELIGIBILITY FILE
S AGEL("U0")=^AUPN3PPH(AGELP("PH"),0),AGEL("U")=""
G:AGELP("TYPE")="MCD" UMCD
F AGZ("I")=1:1 S AGEL("U")=$O(^AUPNPRVT("C",AGELP("PH"),AGEL("U"))) Q:'+AGEL("U") D
.S AGEL("U1")=""
.F AGZ("I")=1:1 S AGEL("U1")=$O(^AUPNPRVT("C",AGELP("PH"),AGEL("U"),AGEL("U1"))) Q:'+AGEL("U1") D
..S DR=".02////"_$P(AGEL("U0"),U,4)_";.03////"_$P(AGEL("U0"),U,5)_";.04////"_$P(AGEL("U0"),U)
..S AGX0=^AUPNPRVT(AGEL("U"),11,AGEL("U1"),0)
..S AGEL("U0BD")=$P(AGEL("U0"),U,17),AGEL("U0ED")=$P(AGEL("U0"),U,18)
..S AGEL("X0BD")=$P(AGX0,U,6),AGEL("X0ED")=$P(AGX0,U,7)
..I (AGEL("X0BD")<AGEL("U0BD")) S DR=DR_";.06////"_AGEL("U0BD")
..I AGEL("U0ED"),(AGEL("X0BD")>AGEL("U0ED")) D
...S DR=DR_";.06////"_AGEL("U0BD")
..I AGEL("X0ED"),(AGEL("X0BD")'<AGEL("X0ED")) D
...S DR=DR_";.06////"_AGEL("U0BD")
..I AGEL("U0ED"),(AGEL("X0ED")>AGEL("U0ED")) D
...S DR=DR_";.07////"_AGEL("U0ED")
..I AGEL("U0ED"),'AGEL("X0ED") S DR=DR_";.07////"_AGEL("U0ED")
..I AGEL("X0ED"),(AGEL("X0ED")<AGEL("U0BD")) D
...S DR=DR_";.07////"_AGEL("U0ED")
..I AGEL("X0ED"),(AGEL("X0ED")'>AGEL("X0BD")) D
...S DR=DR_";.07////"_AGEL("U0ED")
..I ($P(AGX0,U,5)=25) D
...S DR=DR_";.06////"_AGEL("U0BD")_";.07////"_AGEL("U0ED") ;self
..S DA(1)=AGEL("U"),DIE="^AUPNPRVT("_DA(1)_",11,",DA=AGEL("U1") D ^DIE
..S AGEL("DFN")=$S($D(DFN):DFN,1:""),DFN=DA("1")
..D UPDATE^AGED
..S:AGEL("DFN")]"" DFN=AGEL("DFN")
..K AGX0,AGEL("U0BD"),AGEL("U0ED"),AGEL("X0BD"),AGEL("X0ED")
Q
UMCD F AGZ("I")=1:1 S AGEL("U")=$O(^AUPNMCD("C",AGELP("PH"),AGEL("U"))) Q:'+AGEL("U") D
.S DR=".03////"_$P(AGEL("U0"),U,4)_";.05////"_$P(AGEL("U0"),U)
.S DIE="^AUPNMCD(",DA=AGEL("U") D ^DIE
.S AGEL("COV")=$P(AGEL("U0"),U,5),AGEL("X")=AGEL("U") D DEDML^AGEL2
.S AGEL("DFN")=$S($D(DFN):DFN,1:"")
.S AGEL("MCD")=$S($D(AG("MCD")):AG("MCD"),1:"")
.S DFN=$P(^AUPNMCD(AGEL("U"),0),U)
.S AG("MCD")=AGEL("U")
.D UPDATE^AGED5
.S:AGEL("DFN")]"" DFN=AGEL("DFN")
.S:AGEL("MCD")]"" AG("MCD")=AGEL("MCD")
Q
AGEL5 ; IHS/ASDS/EFG - Add/Edit Eligibility PART 5 ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
V14 SET (AGEL("HIT"),AGEL("PT"))=0
FOR AGZ("I")=1:1
SET AGEL("PT")=$ORDER(AGELP(AGEL("PT")))
IF '+AGEL("PT")
QUIT
IF +AGELP(AGEL("PT"))=AGEL
SET AGEL("HIT")=AGEL("PT")
QUIT
+1 IF AGEL("HIT")
WRITE !!,"Policy Member: ",$PIECE(^DPT(AGEL("PT"),0),U)
+2 IF 'AGEL("HIT")
QUIT
+3 NEW AGBILL
+4 SET AGBILL=$$USED^AGED51(AGEL("PT"),"",8,+$PIECE(AGELP(AGEL("HIT")),U,2))
+5 IF $LENGTH(AGBILL)
SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
DO HELP^XBHELP("USED","AGED51")
DO KILL^%ZISS
+6 IF $LENGTH(AGBILL)
IF '$$DIR^XBDIR("Y","Proceed with edit of Date Record","N")
QUIT
+7 IF AGEL("HIT")
+8 IF $TEST
SET DA(1)=AGEL("HIT")
SET DIE="^AUPNPRVT("_DA(1)_",11,"
SET DA=+$PIECE(AGELP(AGEL("HIT")),U,2)
SET DR=".05R~Relationship to Insured..: ;.06Starting Date.. : ;.07Expiration Date...: ;.12Person Code...: ;21Member Number: "
DO ^DIE
+9 QUIT
D14 SET (AGEL("HIT"),AGEL("PT"))=0
+1 FOR AGZ("I")=1:1
SET AGEL("PT")=$ORDER(AGELP(AGEL("PT")))
IF '+AGEL("PT")
QUIT
IF +AGELP(AGEL("PT"))=AGEL
SET AGEL("HIT")=AGELP(AGEL("PT"))
QUIT
+2 IF AGEL("HIT")=0
QUIT
+3 WRITE !!,"Policy Member: ",$PIECE(^DPT(AGEL("PT"),0),U)
+4 SET DA=$PIECE(AGEL("HIT"),U,2)
+5 SET DIE="^AUPNMCD("
SET DR=".06R~Relationship to Insured..: "
+6 DO ^DIE
+7 IF '$DATA(^AUPNMCD(DA,11))
SET ^AUPNMCD(DA,11,0)="^9000004.11D^^"
+8 SET DA(1)=$PIECE(AGEL("HIT"),U,2)
+9 SET DIE="^AUPNMCD("_DA(1)_",11,"
+10 SET DA=$PIECE(AGEL("HIT"),U,3)
+11 SET DR=".02Expiration Date..: "
+12 IF DA]""
DO ^DIE
QUIT
+13 KILL DIC
+14 SET DIC(0)="QEAL"
SET DIC=DIE
SET DIC("DR")=".02Expiration Date..: "
+15 SET DIC("A")=" Effective Date...: "
+16 DO ^DIC
+17 KILL DIC
+18 QUIT
UPDT ;EP - UPDATE FLDS IN ELIGIBILITY FILE
+1 SET AGEL("U0")=^AUPN3PPH(AGELP("PH"),0)
SET AGEL("U")=""
+2 IF AGELP("TYPE")="MCD"
GOTO UMCD
+3 FOR AGZ("I")=1:1
SET AGEL("U")=$ORDER(^AUPNPRVT("C",AGELP("PH"),AGEL("U")))
IF '+AGEL("U")
QUIT
Begin DoDot:1
+4 SET AGEL("U1")=""
+5 FOR AGZ("I")=1:1
SET AGEL("U1")=$ORDER(^AUPNPRVT("C",AGELP("PH"),AGEL("U"),AGEL("U1")))
IF '+AGEL("U1")
QUIT
Begin DoDot:2
+6 SET DR=".02////"_$PIECE(AGEL("U0"),U,4)_";.03////"_$PIECE(AGEL("U0"),U,5)_";.04////"_$PIECE(AGEL("U0"),U)
+7 SET AGX0=^AUPNPRVT(AGEL("U"),11,AGEL("U1"),0)
+8 SET AGEL("U0BD")=$PIECE(AGEL("U0"),U,17)
SET AGEL("U0ED")=$PIECE(AGEL("U0"),U,18)
+9 SET AGEL("X0BD")=$PIECE(AGX0,U,6)
SET AGEL("X0ED")=$PIECE(AGX0,U,7)
+10 IF (AGEL("X0BD")<AGEL("U0BD"))
SET DR=DR_";.06////"_AGEL("U0BD")
+11 IF AGEL("U0ED")
IF (AGEL("X0BD")>AGEL("U0ED"))
Begin DoDot:3
+12 SET DR=DR_";.06////"_AGEL("U0BD")
End DoDot:3
+13 IF AGEL("X0ED")
IF (AGEL("X0BD")'<AGEL("X0ED"))
Begin DoDot:3
+14 SET DR=DR_";.06////"_AGEL("U0BD")
End DoDot:3
+15 IF AGEL("U0ED")
IF (AGEL("X0ED")>AGEL("U0ED"))
Begin DoDot:3
+16 SET DR=DR_";.07////"_AGEL("U0ED")
End DoDot:3
+17 IF AGEL("U0ED")
IF 'AGEL("X0ED")
SET DR=DR_";.07////"_AGEL("U0ED")
+18 IF AGEL("X0ED")
IF (AGEL("X0ED")<AGEL("U0BD"))
Begin DoDot:3
+19 SET DR=DR_";.07////"_AGEL("U0ED")
End DoDot:3
+20 IF AGEL("X0ED")
IF (AGEL("X0ED")'>AGEL("X0BD"))
Begin DoDot:3
+21 SET DR=DR_";.07////"_AGEL("U0ED")
End DoDot:3
+22 IF ($PIECE(AGX0,U,5)=25)
Begin DoDot:3
+23 ;self
SET DR=DR_";.06////"_AGEL("U0BD")_";.07////"_AGEL("U0ED")
End DoDot:3
+24 SET DA(1)=AGEL("U")
SET DIE="^AUPNPRVT("_DA(1)_",11,"
SET DA=AGEL("U1")
DO ^DIE
+25 SET AGEL("DFN")=$SELECT($DATA(DFN):DFN,1:"")
SET DFN=DA("1")
+26 DO UPDATE^AGED
+27 IF AGEL("DFN")]""
SET DFN=AGEL("DFN")
+28 KILL AGX0,AGEL("U0BD"),AGEL("U0ED"),AGEL("X0BD"),AGEL("X0ED")
End DoDot:2
End DoDot:1
+29 QUIT
UMCD FOR AGZ("I")=1:1
SET AGEL("U")=$ORDER(^AUPNMCD("C",AGELP("PH"),AGEL("U")))
IF '+AGEL("U")
QUIT
Begin DoDot:1
+1 SET DR=".03////"_$PIECE(AGEL("U0"),U,4)_";.05////"_$PIECE(AGEL("U0"),U)
+2 SET DIE="^AUPNMCD("
SET DA=AGEL("U")
DO ^DIE
+3 SET AGEL("COV")=$PIECE(AGEL("U0"),U,5)
SET AGEL("X")=AGEL("U")
DO DEDML^AGEL2
+4 SET AGEL("DFN")=$SELECT($DATA(DFN):DFN,1:"")
+5 SET AGEL("MCD")=$SELECT($DATA(AG("MCD")):AG("MCD"),1:"")
+6 SET DFN=$PIECE(^AUPNMCD(AGEL("U"),0),U)
+7 SET AG("MCD")=AGEL("U")
+8 DO UPDATE^AGED5
+9 IF AGEL("DFN")]""
SET DFN=AGEL("DFN")
+10 IF AGEL("MCD")]""
SET AG("MCD")=AGEL("MCD")
End DoDot:1
+11 QUIT
