AGED51 ; IHS/ASDS/EFG - PAGE 5 CONT'D ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
EDIT ;EP
;edit Medicaid #
S DIR(0)="9000004,.03"
S DIR("B")=$G(AG("MNUM"))
D ^DIR
K DIR
G VAR^AGED5:$D(DTOUT)!(Y="^")!(Y="^^")!(Y="/.,")!(Y="^")
I '$D(X) W *7 G VAR^AGED5
EDIT0 G EDIT1:(X=$G(AG("MNUM")))
S DR=".03///"_X
S DA=AG("MCD")
S DIE="^AUPNMCD("
D ^DIE
EDIT1 ;
K DIR,DFOUT,DUOUT,DQOUT,DLOUT,DTOUT
G DATES:'$D(^DD(9000004,.05)) W !!,"Enter the NAME OF THE INSURED person.",!,"(Enter SAME if the PATIENT is the primary insured person.)",!
S DIR("B")=$P(^AUPNMCD(AG("MCD"),0),U,5)
S DIR(0)="F"
D ^DIR
Q:$D(DTOUT)
S:Y="/.,"!(Y="^^") DFOUT=""
S:Y="" DLOUT=""
S:Y="^" (DUOUT,Y)=""
S:Y?1"?".E!(Y["^") (DQOUT,Y)=""
G QUES3:$D(DQOUT),L34:$D(DLOUT)&($P(^AUPNMCD(AG("MCD"),0),U,5)]""),EDIT1:Y="" I Y="SAME" D SAME G EDIT1:$P(^AUPNMCD(AG("MCD"),0),U,5)="",DATES
S DIE("NO^")=""
S DR=".05///"_Y
S DA=AG("MCD"),DIE="^AUPNMCD("
D ^DIE
G EDIT1:$P(^AUPNMCD(AG("MCD"),0),U,5)=""
L34 ;
S DIC="^AUTTRLSH("
S DIC(0)="QAZEM"
S DIC("A")="Enter PATIENT'S RELATIONSHIP to the insured: "
K DIC("B")
S AGREL=+$P(^AUPNMCD(DA,0),U,6)
I AGREL'=0,$D(^AUTTRLSH(AGREL,0)) S DIC("B")=$P(^AUTTRLSH(AGREL,0),U)
K AGREL
W !
D ^DIC
G EDIT1:$D(DUOUT),L34:+Y<1
S DA=AG("MCD")
S $P(^AUPNMCD(DA,0),U,6)=+Y
K DIC
SEX W !
S DIE="^AUPNMCD("
S DA=AGELPTR
S DR=.07,DIE("NO^")=""
D ^DIE
DATES D DATES1
D PCP
D CCOPY
MCDNM W !
S DIE="^AUPNMCD("
S DA=AG("MCD")
S DR=2101
D ^DIE
I '$D(^AUPNMCD(AG("MCD"),21)) G MCDDB
D:$P(^AUPNMCD(AG("MCD"),21),U)]"" SETOTHER G MCDDB
SETOTHER ;
Q
S DIE="^DPT("
S DA=DFN
S DR="1///"_$P(^AUPNMCD(AG("MCD"),21),U)
S DR(2,2.01)=.01
D ^DIE
Q
MCDDB W !
S DIE="^AUPNMCD("
S DA=AG("MCD")
S DR=2102
D ^DIE
S DR=".11;.12"
D ^DIE
G VAR^AGED5
QUES3 W !!
W "Enter the name of the person in whose name the main account is carried."
W !,"The name must be in the same format as the patient names.",!!
W "If the patient is the primary insured person, enter SAME.",!!
G EDIT1
SAME S DA=AG("MCD")
S DR=".05///"_$P(^DPT(DFN,0),U)
S DIE="^AUPNMCD("
D ^DIE
S DR=".07///"_$P(^DPT(DFN,0),U,2)_";.06///SELF"
D ^DIE
Q
DATES1 ;
KILL DIE("NO^")
NEW AGBILL,AGDA,DA,DIC,DIE,DR
S DIC="^AUPNMCD("_AG("MCD")_",11,"
S DIC(0)="AEL"
S DIC("A")="Select ELIG. DATE: "
S DA(1)=AG("MCD")
I '$D(^AUPNMCD(AG("MCD"),11)) S DIC("P")=$P(^DD(9000004,1101,0),U,2)
E I $P($G(^AUPNMCD(AG("MCD"),11,0)),U,4) S Y=$P(^AUPNMCD(AG("MCD"),11,$O(^AUPNMCD(AG("MCD"),11,0)),0),U,1) I Y D DD^%DT S DIC("B")=Y
D ^DIC
Q:+Y<1
S AGDA=+Y
S AGBILL=$$USED(DFN,$P(^AUPNMCD(AG("MCD"),0),U,2),7,+Y,AG("MCD"))
I $L(AGBILL) S X="IORVON;IORVOFF" D ENDR^%ZISS,HELP^XBHELP("USED","AGED51"),KILL^%ZISS Q:'$$DIR^XBDIR("Y","Proceed with edit of Date Record","N")
W !
S DA(1)=AG("MCD")
S DIE="^AUPNMCD("_DA(1)_",11,"
S DR=".01:.03",DA=AGDA
D ^DIE,UPDATE^AGED5
Q
PCP ;
S DA=AG("MCD")
S DR=.14
S DIE="^AUPNMCD("
D ^DIE
Q
CCOPY ;
S DA=AG("MCD")
S DR=.15
S DIE="^AUPNMCD("
D ^DIE
I X["Y" D
.S DR=.16
.S DIE="^AUPNMCD("
.D ^DIE
I X["N" D
.S DR=".16////@"
.S DIE="^AUPNMCD("
.D ^DIE
Q
USED(DFN,AGINSPTR,AGP,AGDA,AGMCDDA) ;EP - Is this Eligibility date record used in a 3P Bill or Claim?
;;@;*7
;;@;IORVON
;;WARNING :
;;@;IORVOFF
;; You have selected an Eligibility Date Record that is used
;; by
;;@;AGBILL
;; in 3PB. Modifying or deleting this Eligibility
;; Date Record will degrade the integrity of your database
;; and could adversely effect revenue recovery through 3PB!!
;;###
;
NEW AGBILL,AGDUZ2,AGUSED,AG13,Y
S (AGBILL,AGDUZ2,AGUSED)=0
;Check all Pt's bills.
F S AGDUZ2=$O(^ABMDBILL(AGDUZ2)) Q:'AGDUZ2 D Q:AGUSED
. F S AGBILL=$O(^ABMDBILL(AGDUZ2,"D",DFN,AGBILL)) Q:'AGBILL D Q:AGUSED
.. I $P(^ABMDBILL(AGDUZ2,AGBILL,0),U,4)="X" Q ;Cancelled.
.. S AG13=0
.. F S AG13=$O(^ABMDBILL(AGDUZ2,AGBILL,13,AG13)) Q:'AG13 D Q:AGUSED
... ;Same multiple?
... Q:'($P(^ABMDBILL(AGDUZ2,AGBILL,13,AG13,0),U,AGP)=AGDA)
... ;If MCD, same IEN?
... I AGP=7,'($P(^ABMDBILL(AGDUZ2,AGBILL,13,AG13,0),U,6)=AGMCDDA) Q
... S AGUSED=$P(^ABMDBILL(AGDUZ2,AGBILL,0),U)_" ("_$P(^DIC(4,AGDUZ2,0),U)_")" ; Bill number (Site).
...Q
..Q
.Q
I AGUSED Q "Bill # "_AGUSED
;
S (AGBILL,AGDUZ2,AGUSED)=0
;Check all Pt's claims.
F S AGDUZ2=$O(^ABMDCLM(AGDUZ2)) Q:'AGDUZ2 D Q:AGUSED
. F S AGBILL=$O(^ABMDCLM(AGDUZ2,"B",DFN,AGBILL)) Q:'AGBILL D Q:AGUSED
.. S AG13=0
.. F S AG13=$O(^ABMDCLM(AGDUZ2,AGBILL,13,AG13)) Q:'AG13 D Q:AGUSED
... ;Same multiple?
... Q:'($P(^ABMDCLM(AGDUZ2,AGBILL,13,AG13,0),U,AGP)=AGDA)
... ;If MCD, same IEN?
... I AGP=7,'($P(^ABMDCLM(AGDUZ2,AGBILL,13,AG13,0),U,6)=AGMCDDA) Q
... S AGUSED=AGBILL_" ("_$P(^DIC(4,AGDUZ2,0),U)_")" ;Claim number (Site).
...Q
..Q
.Q
I AGUSED Q "Claim # "_AGUSED
Q ""
;
; MEDICARE MULTIPLE (NJ6,0), [0;4]
; RAILROAD MULTIPLE (NJ6,0), [0;5]
; MEDICAID ELIG POINTER (*P9000004'), [0;6]
; MEDICAID MULTIPLE (NJ4,0), [0;7]
; PRIVATE INSURANCE MULTIPLE (NJ6,0), [0;8]
AGED51 ; IHS/ASDS/EFG - PAGE 5 CONT'D ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
EDIT ;EP
+1 ;edit Medicaid #
+2 SET DIR(0)="9000004,.03"
+3 SET DIR("B")=$GET(AG("MNUM"))
+4 DO ^DIR
+5 KILL DIR
+6 IF $DATA(DTOUT)!(Y="^")!(Y="^^")!(Y="/.,")!(Y="^")
GOTO VAR^AGED5
+7 IF '$DATA(X)
WRITE *7
GOTO VAR^AGED5
EDIT0 IF (X=$GET(AG("MNUM")))
GOTO EDIT1
+1 SET DR=".03///"_X
+2 SET DA=AG("MCD")
+3 SET DIE="^AUPNMCD("
+4 DO ^DIE
EDIT1 ;
+1 KILL DIR,DFOUT,DUOUT,DQOUT,DLOUT,DTOUT
+2 IF '$DATA(^DD(9000004,.05))
GOTO DATES
WRITE !!,"Enter the NAME OF THE INSURED person.",!,"(Enter SAME if the PATIENT is the primary insured person.)",!
+3 SET DIR("B")=$PIECE(^AUPNMCD(AG("MCD"),0),U,5)
+4 SET DIR(0)="F"
+5 DO ^DIR
+6 IF $DATA(DTOUT)
QUIT
+7 IF Y="/.,"!(Y="^^")
SET DFOUT=""
+8 IF Y=""
SET DLOUT=""
+9 IF Y="^"
SET (DUOUT,Y)=""
+10 IF Y?1"?".E!(Y["^")
SET (DQOUT,Y)=""
+11 IF $DATA(DQOUT)
GOTO QUES3
IF $DATA(DLOUT)&($PIECE(^AUPNMCD(AG("MCD"),0),U,5)]"")
GOTO L34
IF Y=""
GOTO EDIT1
IF Y="SAME"
DO SAME
IF $PIECE(^AUPNMCD(AG("MCD"),0),U,5)=""
GOTO EDIT1
GOTO DATES
+12 SET DIE("NO^")=""
+13 SET DR=".05///"_Y
+14 SET DA=AG("MCD")
SET DIE="^AUPNMCD("
+15 DO ^DIE
+16 IF $PIECE(^AUPNMCD(AG("MCD"),0),U,5)=""
GOTO EDIT1
L34 ;
+1 SET DIC="^AUTTRLSH("
+2 SET DIC(0)="QAZEM"
+3 SET DIC("A")="Enter PATIENT'S RELATIONSHIP to the insured: "
+4 KILL DIC("B")
+5 SET AGREL=+$PIECE(^AUPNMCD(DA,0),U,6)
+6 IF AGREL'=0
IF $DATA(^AUTTRLSH(AGREL,0))
SET DIC("B")=$PIECE(^AUTTRLSH(AGREL,0),U)
+7 KILL AGREL
+8 WRITE !
+9 DO ^DIC
+10 IF $DATA(DUOUT)
GOTO EDIT1
IF +Y<1
GOTO L34
+11 SET DA=AG("MCD")
+12 SET $PIECE(^AUPNMCD(DA,0),U,6)=+Y
+13 KILL DIC
SEX WRITE !
+1 SET DIE="^AUPNMCD("
+2 SET DA=AGELPTR
+3 SET DR=.07
SET DIE("NO^")=""
+4 DO ^DIE
DATES DO DATES1
+1 DO PCP
+2 DO CCOPY
MCDNM WRITE !
+1 SET DIE="^AUPNMCD("
+2 SET DA=AG("MCD")
+3 SET DR=2101
+4 DO ^DIE
+5 IF '$DATA(^AUPNMCD(AG("MCD"),21))
GOTO MCDDB
+6 IF $PIECE(^AUPNMCD(AG("MCD"),21),U)]""
DO SETOTHER
GOTO MCDDB
SETOTHER ;
+1 QUIT
+2 SET DIE="^DPT("
+3 SET DA=DFN
+4 SET DR="1///"_$PIECE(^AUPNMCD(AG("MCD"),21),U)
+5 SET DR(2,2.01)=.01
+6 DO ^DIE
+7 QUIT
MCDDB WRITE !
+1 SET DIE="^AUPNMCD("
+2 SET DA=AG("MCD")
+3 SET DR=2102
+4 DO ^DIE
+5 SET DR=".11;.12"
+6 DO ^DIE
+7 GOTO VAR^AGED5
QUES3 WRITE !!
+1 WRITE "Enter the name of the person in whose name the main account is carried."
+2 WRITE !,"The name must be in the same format as the patient names.",!!
+3 WRITE "If the patient is the primary insured person, enter SAME.",!!
+4 GOTO EDIT1
SAME SET DA=AG("MCD")
+1 SET DR=".05///"_$PIECE(^DPT(DFN,0),U)
+2 SET DIE="^AUPNMCD("
+3 DO ^DIE
+4 SET DR=".07///"_$PIECE(^DPT(DFN,0),U,2)_";.06///SELF"
+5 DO ^DIE
+6 QUIT
DATES1 ;
+1 KILL DIE("NO^")
+2 NEW AGBILL,AGDA,DA,DIC,DIE,DR
+3 SET DIC="^AUPNMCD("_AG("MCD")_",11,"
+4 SET DIC(0)="AEL"
+5 SET DIC("A")="Select ELIG. DATE: "
+6 SET DA(1)=AG("MCD")
+7 IF '$DATA(^AUPNMCD(AG("MCD"),11))
SET DIC("P")=$PIECE(^DD(9000004,1101,0),U,2)
+8 IF '$TEST
IF $PIECE($GET(^AUPNMCD(AG("MCD"),11,0)),U,4)
SET Y=$PIECE(^AUPNMCD(AG("MCD"),11,$ORDER(^AUPNMCD(AG("MCD"),11,0)),0),U,1)
IF Y
DO DD^%DT
SET DIC("B")=Y
+9 DO ^DIC
+10 IF +Y<1
QUIT
+11 SET AGDA=+Y
+12 SET AGBILL=$$USED(DFN,$PIECE(^AUPNMCD(AG("MCD"),0),U,2),7,+Y,AG("MCD"))
+13 IF $LENGTH(AGBILL)
SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
DO HELP^XBHELP("USED","AGED51")
DO KILL^%ZISS
IF '$$DIR^XBDIR("Y","Proceed with edit of Date Record","N")
QUIT
+14 WRITE !
+15 SET DA(1)=AG("MCD")
+16 SET DIE="^AUPNMCD("_DA(1)_",11,"
+17 SET DR=".01:.03"
SET DA=AGDA
+18 DO ^DIE
DO UPDATE^AGED5
+19 QUIT
PCP ;
+1 SET DA=AG("MCD")
+2 SET DR=.14
+3 SET DIE="^AUPNMCD("
+4 DO ^DIE
+5 QUIT
CCOPY ;
+1 SET DA=AG("MCD")
+2 SET DR=.15
+3 SET DIE="^AUPNMCD("
+4 DO ^DIE
+5 IF X["Y"
Begin DoDot:1
+6 SET DR=.16
+7 SET DIE="^AUPNMCD("
+8 DO ^DIE
End DoDot:1
+9 IF X["N"
Begin DoDot:1
+10 SET DR=".16////@"
+11 SET DIE="^AUPNMCD("
+12 DO ^DIE
End DoDot:1
+13 QUIT
USED(DFN,AGINSPTR,AGP,AGDA,AGMCDDA) ;EP - Is this Eligibility date record used in a 3P Bill or Claim?
+1 ;;@;*7
+2 ;;@;IORVON
+3 ;;WARNING :
+4 ;;@;IORVOFF
+5 ;; You have selected an Eligibility Date Record that is used
+6 ;; by
+7 ;;@;AGBILL
+8 ;; in 3PB. Modifying or deleting this Eligibility
+9 ;; Date Record will degrade the integrity of your database
+10 ;; and could adversely effect revenue recovery through 3PB!!
+11 ;;###
+12 ;
+13 NEW AGBILL,AGDUZ2,AGUSED,AG13,Y
+14 SET (AGBILL,AGDUZ2,AGUSED)=0
+15 ;Check all Pt's bills.
+16 FOR
SET AGDUZ2=$ORDER(^ABMDBILL(AGDUZ2))
IF 'AGDUZ2
QUIT
Begin DoDot:1
+17 FOR
SET AGBILL=$ORDER(^ABMDBILL(AGDUZ2,"D",DFN,AGBILL))
IF 'AGBILL
QUIT
Begin DoDot:2
+18 ;Cancelled.
IF $PIECE(^ABMDBILL(AGDUZ2,AGBILL,0),U,4)="X"
QUIT
+19 SET AG13=0
+20 FOR
SET AG13=$ORDER(^ABMDBILL(AGDUZ2,AGBILL,13,AG13))
IF 'AG13
QUIT
Begin DoDot:3
+21 ;Same multiple?
+22 IF '($PIECE(^ABMDBILL(AGDUZ2,AGBILL,13,AG13,0),U,AGP)=AGDA)
QUIT
+23 ;If MCD, same IEN?
+24 IF AGP=7
IF '($PIECE(^ABMDBILL(AGDUZ2,AGBILL,13,AG13,0),U,6)=AGMCDDA)
QUIT
+25 ; Bill number (Site).
SET AGUSED=$PIECE(^ABMDBILL(AGDUZ2,AGBILL,0),U)_" ("_$PIECE(^DIC(4,AGDUZ2,0),U)_")"
+26 QUIT
End DoDot:3
IF AGUSED
QUIT
+27 QUIT
End DoDot:2
IF AGUSED
QUIT
+28 QUIT
End DoDot:1
IF AGUSED
QUIT
+29 IF AGUSED
QUIT "Bill # "_AGUSED
+30 ;
+31 SET (AGBILL,AGDUZ2,AGUSED)=0
+32 ;Check all Pt's claims.
+33 FOR
SET AGDUZ2=$ORDER(^ABMDCLM(AGDUZ2))
IF 'AGDUZ2
QUIT
Begin DoDot:1
+34 FOR
SET AGBILL=$ORDER(^ABMDCLM(AGDUZ2,"B",DFN,AGBILL))
IF 'AGBILL
QUIT
Begin DoDot:2
+35 SET AG13=0
+36 FOR
SET AG13=$ORDER(^ABMDCLM(AGDUZ2,AGBILL,13,AG13))
IF 'AG13
QUIT
Begin DoDot:3
+37 ;Same multiple?
+38 IF '($PIECE(^ABMDCLM(AGDUZ2,AGBILL,13,AG13,0),U,AGP)=AGDA)
QUIT
+39 ;If MCD, same IEN?
+40 IF AGP=7
IF '($PIECE(^ABMDCLM(AGDUZ2,AGBILL,13,AG13,0),U,6)=AGMCDDA)
QUIT
+41 ;Claim number (Site).
SET AGUSED=AGBILL_" ("_$PIECE(^DIC(4,AGDUZ2,0),U)_")"
+42 QUIT
End DoDot:3
IF AGUSED
QUIT
+43 QUIT
End DoDot:2
IF AGUSED
QUIT
+44 QUIT
End DoDot:1
IF AGUSED
QUIT
+45 IF AGUSED
QUIT "Claim # "_AGUSED
+46 QUIT ""
+47 ;
+48 ; MEDICARE MULTIPLE (NJ6,0), [0;4]
+49 ; RAILROAD MULTIPLE (NJ6,0), [0;5]
+50 ; MEDICAID ELIG POINTER (*P9000004'), [0;6]
+51 ; MEDICAID MULTIPLE (NJ4,0), [0;7]
+52 ; PRIVATE INSURANCE MULTIPLE (NJ6,0), [0;8]
