- 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