AGEL2 ; IHS/ASDS/EFG - Add/Edit Eligibility Info PAGE 2 ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
D14 K DIC,AGELP("RELSH") S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select Member to ADD..: "
D ^DIC I +Y<1 Q
I $D(AGELP(+Y)) W *7 Q
DENT S X=+Y,DIC(0)="L",DIC="^AUPNMCD("
S AGEL("IDFN")=$O(^AUTNINS("B","MEDICAID",""))
I AGEL("IDFN")="" Q
S AGEL("ST")=$O(^AUTNINS(AGEL("IDFN"),13,"C",AGELP("INS"),"")) Q:AGEL("ST")=""
I $D(AGELP("MODE")),AGELP("MODE")="A",$D(AG("NUM")) S AGEL("POL")=AG("NUM")
E S AGEL("POL")=$P(^AUPN3PPH(AGELP("PH"),0),U,4),AGEL("COV")=$P(^(0),U,5)
I AGEL("POL")]"" S AGEL("X")=$O(^AUPNMCD("AB",+Y,AGEL("ST"),AGEL("POL"),"")) I AGEL("X")]"" G DEDIT
S DIC("DR")=".02////"_AGEL("IDFN")_";.03////"_AGEL("POL")
S DIC("DR")=DIC("DR")_";.04////"_$O(^AUTNINS(AGEL("IDFN"),13,"C",AGELP("INS"),""))
S DIC("DR")=DIC("DR")_";.05////"_$P($P(AGV("X2"),U),";",2)
I AGELP("SAME") S DIC("DR")=DIC("DR")_";.06///SELF"
E I $D(AGELP("RELSH")) S DIC("DR")=DIC("DR")_";.06////"_AGELP("RELSH")
E S DIC("DR")=DIC("DR")_";.06R~Relationship to Insured..: "
S DIC("DR")=DIC("DR")_";.09////"_AGELP("PH")
K DD,DO D FILE^DICN K DIC Q:+Y<1
S AGEL("X")=+Y
S AGEL("DFN")=$S($D(DFN):DFN,1:""),AGEL("MCD")=$S($D(AG("MCD")):AG("MCD"),1:""),DFN=X,AG("MCD")=+Y D UPDATE^AGED5 S:AGEL("DFN")]"" DFN=AGEL("DFN") S:AGEL("MCD")]"" AG("MCD")=AGEL("MCD")
DMULT I '$D(^AUPNMCD(AGEL("X"),11)) S ^AUPNMCD(AGEL("X"),11,0)="^9000004.11D^^"
S AGEL("BDT")=$P(^AUPN3PPH(AGELP("PH"),0),U,17) Q:AGEL("BDT")=""
S DA(1)=AGEL("X"),DIC="^AUPNMCD("_DA(1)_",11,"
S (X,DINUM)=AGEL("BDT"),DIC(0)="L"
K DD,DO S DIC("DR")=".02////"_$P(^AUPN3PPH(AGELP("PH"),0),U,18)
S AGEL("COV")=$P(^AUPN3PPH(AGELP("PH"),0),U,5)
I AGEL("COV")]"" S DIC("DR")=DIC("DR")_".03////"_$S($D(^AUTTPIC(AGEL("COV"),0)):$P(^(0),U),1:"")_";.04////"_AGEL("COV")
K DD,DO D FILE^DICN K DIC,DINUMA
Q
DEDIT S DIE="^AUPNMCD(",DA=AGEL("X")
S DR=".02////"_AGEL("IDFN")
S DR=DR_";.03////"_AGEL("POL")
S DR=DR_";.04////"_AGEL("ST")
S DR=DR_";.05////"_$P($P(AGV("X2"),U),";",2)
I AGELP("SAME") S DR=DR_";.06///SELF"
E I $D(AGELP("RELSH")) S DR=DR_";.06////"_AGELP("RELSH")
E S DR=DR_";.06R~Relationship to Insured..: "
S DR=DR_";.09////"_AGELP("PH")
D ^DIE
I $D(X),X>0 S AGEL("DFN")=$S($D(DFN):DFN,1:""),AGEL("MCD")=$S($D(AG("MCD")):AG("MCD"),1:""),DFN=X,DA=AGEL("X") D UPDATE^AGED5 S:AGEL("DFN")]"" DFN=AGEL("DFN") S:AGEL("MCD")]"" AG("MCD")=AGEL("MCD")
DEDML ;EP
S AGEL("BDT")=$P(^AUPN3PPH(AGELP("PH"),0),U,17) Q:AGEL("BDT")=""
I '$D(^AUPNMCD(AGEL("X"),11)) G DMULT
S (AGEL("DT"),AGEL("DUP"))=0 F AGZ("I")=1:1 S AGEL("DT")=$O(^AUPNMCD(AGEL("X"),11,AGEL("DT"))) Q:'+AGEL("DT") S AGEL("DT0")=^(AGEL("DT"),0) D
.I $P(AGEL("DT0"),U,2)=""&($P(AGEL("DT0"),U,3)="") D DKILL Q
.I $P(AGEL("DT0"),U,2)="",$P(AGEL("DT0"),U,3)=AGEL("COV") D @($S(AGEL("DUP")=0:"DUP",1:"DKILL")) Q
.I AGEL("BDT")<$P(AGEL("DT0"),U,2),$P(AGEL("DT0"),U,3)=AGEL("COV")!(AGEL("COV")="")!($P(AGEL("DT0"),U,3)="") D DUP
I AGEL("DUP")=0 G DMULT
Q
DUP I AGEL("DUP") D DKILL Q
S DA(1)=AGEL("X"),DA=AGEL("DT"),DIE="^AUPNMCD("_DA(1)_",11,"
S DR=".02////"_$P(^AUPN3PPH(AGELP("PH"),0),U,18)
I AGEL("COV")]"" S DR=DR_";.03////"_$S($D(^AUTTPIC(AGEL("COV"),0)):$P(^(0),U),1:"")_";.04////"_AGEL("COV")
D ^DIE S AGEL("DUP")=1
Q
DKILL S DA(1)=AGEL("X"),DA=AGEL("DT"),DIK="^AUPNMCD("_DA(1)_",11," D ^DIK
Q
AGEL2 ; IHS/ASDS/EFG - Add/Edit Eligibility Info PAGE 2 ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
D14 KILL DIC,AGELP("RELSH")
SET DIC="^DPT("
SET DIC(0)="QEAM"
SET DIC("A")="Select Member to ADD..: "
+1 DO ^DIC
IF +Y<1
QUIT
+2 IF $DATA(AGELP(+Y))
WRITE *7
QUIT
DENT SET X=+Y
SET DIC(0)="L"
SET DIC="^AUPNMCD("
+1 SET AGEL("IDFN")=$ORDER(^AUTNINS("B","MEDICAID",""))
+2 IF AGEL("IDFN")=""
QUIT
+3 SET AGEL("ST")=$ORDER(^AUTNINS(AGEL("IDFN"),13,"C",AGELP("INS"),""))
IF AGEL("ST")=""
QUIT
+4 IF $DATA(AGELP("MODE"))
IF AGELP("MODE")="A"
IF $DATA(AG("NUM"))
SET AGEL("POL")=AG("NUM")
+5 IF '$TEST
SET AGEL("POL")=$PIECE(^AUPN3PPH(AGELP("PH"),0),U,4)
SET AGEL("COV")=$PIECE(^(0),U,5)
+6 IF AGEL("POL")]""
SET AGEL("X")=$ORDER(^AUPNMCD("AB",+Y,AGEL("ST"),AGEL("POL"),""))
IF AGEL("X")]""
GOTO DEDIT
+7 SET DIC("DR")=".02////"_AGEL("IDFN")_";.03////"_AGEL("POL")
+8 SET DIC("DR")=DIC("DR")_";.04////"_$ORDER(^AUTNINS(AGEL("IDFN"),13,"C",AGELP("INS"),""))
+9 SET DIC("DR")=DIC("DR")_";.05////"_$PIECE($PIECE(AGV("X2"),U),";",2)
+10 IF AGELP("SAME")
SET DIC("DR")=DIC("DR")_";.06///SELF"
+11 IF '$TEST
IF $DATA(AGELP("RELSH"))
SET DIC("DR")=DIC("DR")_";.06////"_AGELP("RELSH")
+12 IF '$TEST
SET DIC("DR")=DIC("DR")_";.06R~Relationship to Insured..: "
+13 SET DIC("DR")=DIC("DR")_";.09////"_AGELP("PH")
+14 KILL DD,DO
DO FILE^DICN
KILL DIC
IF +Y<1
QUIT
+15 SET AGEL("X")=+Y
+16 SET AGEL("DFN")=$SELECT($DATA(DFN):DFN,1:"")
SET AGEL("MCD")=$SELECT($DATA(AG("MCD")):AG("MCD"),1:"")
SET DFN=X
SET AG("MCD")=+Y
DO UPDATE^AGED5
IF AGEL("DFN")]""
SET DFN=AGEL("DFN")
IF AGEL("MCD")]""
SET AG("MCD")=AGEL("MCD")
DMULT IF '$DATA(^AUPNMCD(AGEL("X"),11))
SET ^AUPNMCD(AGEL("X"),11,0)="^9000004.11D^^"
+1 SET AGEL("BDT")=$PIECE(^AUPN3PPH(AGELP("PH"),0),U,17)
IF AGEL("BDT")=""
QUIT
+2 SET DA(1)=AGEL("X")
SET DIC="^AUPNMCD("_DA(1)_",11,"
+3 SET (X,DINUM)=AGEL("BDT")
SET DIC(0)="L"
+4 KILL DD,DO
SET DIC("DR")=".02////"_$PIECE(^AUPN3PPH(AGELP("PH"),0),U,18)
+5 SET AGEL("COV")=$PIECE(^AUPN3PPH(AGELP("PH"),0),U,5)
+6 IF AGEL("COV")]""
SET DIC("DR")=DIC("DR")_".03////"_$SELECT($DATA(^AUTTPIC(AGEL("COV"),0)):$PIECE(^(0),U),1:"")_";.04////"_AGEL("COV")
+7 KILL DD,DO
DO FILE^DICN
KILL DIC,DINUMA
+8 QUIT
DEDIT SET DIE="^AUPNMCD("
SET DA=AGEL("X")
+1 SET DR=".02////"_AGEL("IDFN")
+2 SET DR=DR_";.03////"_AGEL("POL")
+3 SET DR=DR_";.04////"_AGEL("ST")
+4 SET DR=DR_";.05////"_$PIECE($PIECE(AGV("X2"),U),";",2)
+5 IF AGELP("SAME")
SET DR=DR_";.06///SELF"
+6 IF '$TEST
IF $DATA(AGELP("RELSH"))
SET DR=DR_";.06////"_AGELP("RELSH")
+7 IF '$TEST
SET DR=DR_";.06R~Relationship to Insured..: "
+8 SET DR=DR_";.09////"_AGELP("PH")
+9 DO ^DIE
+10 IF $DATA(X)
IF X>0
SET AGEL("DFN")=$SELECT($DATA(DFN):DFN,1:"")
SET AGEL("MCD")=$SELECT($DATA(AG("MCD")):AG("MCD"),1:"")
SET DFN=X
SET DA=AGEL("X")
DO UPDATE^AGED5
IF AGEL("DFN")]""
SET DFN=AGEL("DFN")
IF AGEL("MCD")]""
SET AG("MCD")=AGEL("MCD")
DEDML ;EP
+1 SET AGEL("BDT")=$PIECE(^AUPN3PPH(AGELP("PH"),0),U,17)
IF AGEL("BDT")=""
QUIT
+2 IF '$DATA(^AUPNMCD(AGEL("X"),11))
GOTO DMULT
+3 SET (AGEL("DT"),AGEL("DUP"))=0
FOR AGZ("I")=1:1
SET AGEL("DT")=$ORDER(^AUPNMCD(AGEL("X"),11,AGEL("DT")))
IF '+AGEL("DT")
QUIT
SET AGEL("DT0")=^(AGEL("DT"),0)
Begin DoDot:1
+4 IF $PIECE(AGEL("DT0"),U,2)=""&($PIECE(AGEL("DT0"),U,3)="")
DO DKILL
QUIT
+5 IF $PIECE(AGEL("DT0"),U,2)=""
IF $PIECE(AGEL("DT0"),U,3)=AGEL("COV")
DO @($SELECT(AGEL("DUP")=0:"DUP",1:"DKILL"))
QUIT
+6 IF AGEL("BDT")<$PIECE(AGEL("DT0"),U,2)
IF $PIECE(AGEL("DT0"),U,3)=AGEL("COV")!(AGEL("COV")="")!($PIECE(AGEL("DT0"),U,3)="")
DO DUP
End DoDot:1
+7 IF AGEL("DUP")=0
GOTO DMULT
+8 QUIT
DUP IF AGEL("DUP")
DO DKILL
QUIT
+1 SET DA(1)=AGEL("X")
SET DA=AGEL("DT")
SET DIE="^AUPNMCD("_DA(1)_",11,"
+2 SET DR=".02////"_$PIECE(^AUPN3PPH(AGELP("PH"),0),U,18)
+3 IF AGEL("COV")]""
SET DR=DR_";.03////"_$SELECT($DATA(^AUTTPIC(AGEL("COV"),0)):$PIECE(^(0),U),1:"")_";.04////"_AGEL("COV")
+4 DO ^DIE
SET AGEL("DUP")=1
+5 QUIT
DKILL SET DA(1)=AGEL("X")
SET DA=AGEL("DT")
SET DIK="^AUPNMCD("_DA(1)_",11,"
DO ^DIK
+1 QUIT
