AGEL ; IHS/ASDS/EFG - Add/Edit Eligibility Information ;
;;7.1;PATIENT REGISTRATION;**1,2,12**;AUG 25, 2005;Build 1
;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
;
HEAD S U="^"
INS ;EP - EDIT AN INSURER
G INS2:$D(AGNEWINS)
W !!
K DIC
S DIC="^AUTNINS(",DIC(0)="AEMQ",DIC("A")="Select INSURER: "
;IHS/OIT/NKD AG*7.1*12 - START OLD CODE
;I $G(AGELP("TYPE"))="PI" S DIC("S")="I $D(^(1)),$P(^(1),U,7),$P(^(0),U)'=""MEDICAID"",$D(^(2)),""NRDI""'[$P(^(2),U)"
;E S DIC("S")="I $D(^(1)),$P(^(1),U,7),$D(^(2)),""NDR""'[$P(^(2),U)"
;IHS/OIT/NKD AG*7.1*12 - END OLD CODE - START NEW CODE
I $G(AGELP("TYPE"))="PI" S DIC("S")="I $D(^(1)),$P(^(1),U,7),$P(^(0),U)'=""MEDICAID"",""NRDI""'[$$INSTYP^AGUTL(Y)"
E S DIC("S")="I $D(^(1)),$P(^(1),U,7),""NDR""'[$$INSTYP^AGUTL(Y)"
;IHS/OIT/NKD AG*7.1*12 - END NEW CODE
K DTOUT,DUOUT
D ^DIC
G XIT:X=""!$D(DTOUT)!$D(DUOUT),INS:Y=-1
S AGELP("INS")=+Y
G PH
INS2 ;
I $D(AGELP("PDFN")),$D(^AUPNPRVT("I",AGELP("INS"),AGELP("PDFN"))) W *7,!!,"WARNING: If you proceed you will be ADDING an Insurer that the Patient already",!," has an Eligibility Record for!"
K DTOUT,DUOUT
I W ! K DIR S DIR(0)="Y",DIR("A")=" Do you wish to proceed" D ^DIR K DIR W:Y=1 " (OK, then proceed with caution)"
I Y=0!$D(DTOUT)!$D(DIRUT)!(Y="^") G XIT
PH K AGEL
F AGEL="PH","TYPE","INS","MODE","PDFN","HRN" I $D(AGELP(AGEL)) S AGEL(AGEL)=AGELP(AGEL)
K AGELP
F AGEL="PH","TYPE","INS","MODE","PDFN","HRN" I $D(AGEL(AGEL)) S AGELP(AGEL)=AGEL(AGEL)
K AGEL
W !!,"Enter the NAME of the POLICY HOLDER or the POLICY NUMBER if it already exists."
I $D(AGELP("PDFN")) W !?10,"(Enter 'SAME' if the PATIENT is the Policy Holder.)"
K DIR
W !
S DIR(0)="FO^1:30",DIR("A")="Select POLICY HOLDER",AGEL("D")="^AUPN3PPH(",AGEL("D0")="QZEM",AGEL("DS")="I $P(^(0),U,3)=AGELP(""INS"")" I $D(AGELP("TYPE")),AGELP("TYPE")="MCD",$D(AG("NUM")) S AGEL("DS")=AGEL("DS")_",$P(^(0),U,4)=AG(""NUM"")"
S DIR("?",1)="Enter Name of the person in whose name the account is carried or"
S DIR("?",2)="the Policy Number if the Policy already exists."
S DIR("?",3)=""
S DIR("?")="(NOTE: Existing Policy Holders are displayed by entering ""??"")"
S DIR("??")="^S X=""??"",DIC=AGEL(""D""),DIC(0)=AGEL(""D0""),DIC(""S"")=AGEL(""DS"") D ^DIC"
D ^DIR
S:Y="/.,"!(Y="^^") DFOUT=""
S:Y="" DLOUT=""
S:Y="^" (DUOUT,Y)=""
S:Y?1"?".E!(Y["^") (DQOUT,Y)=""
K DIR
I $D(DIROUT)!$D(DIRUT)!$D(DUOUT)!$D(DTOUT) W !!,"Not adding insurer...." H 2 G XIT
I $D(AGELP("PDFN")),X="SAME"!(X="SELF") S (Y,X)=$P(^DPT(AGELP("PDFN"),0),U),AGELP("SAME")=1 D PCHK^AGEL1 G HIT
E S AGELP("SAME")=0
S AGEL("X")=X
;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 18
I $G(AGELP("INS")) D
.N INSTYP,INSNM
.;S INSTYP=$P($G(^AUTNINS(AGELP("INS"),2)),U)
.S INSTYP=$$INSTYP^AGUTL(AGELP("INS")) ;IHS/OIT/NKD AG*7.1*12
.S INSNM=$P($G(^AUTNINS(AGELP("INS"),0)),U)
;END NEW CODE
W !
K DIC
S DIC(0)="EM",DIC="^AUPN3PPH(",DIC("S")="I $P(^(0),U,3)=AGELP(""INS"")"
D ^DIC
I +Y<1 D PCHK^AGEL1 G XIT:$D(DIROUT)!$D(DIRUT)!$D(DUOUT)!$D(DTOUT),INS:+Y<1
HIT S AGELP("PH")=+Y,AGELP("Y")=Y
I $P(^AUPN3PPH(+Y,0),U,2)]"" S AGELP("PHPAT")=$P(^(0),U,2)
S AGELP("MODE")="E" I $P(Y,U,3)=1 S AGELP("MODE")="A"
I $D(AGELP("PDFN")),AGELP("TYPE")="MCD" I 0 S AGEL("I")="" F AGZ("I")=1:1 S AGEL("I")=$O(^AUPNMCD("C",AGELP("PH"),AGEL("I"))) Q:'+AGEL("I") I $P(^AUPNMCD(AGEL("I"),0),U)=AGELP("PDFN") Q
I G DISP
I $D(AGELP("PDFN")),AGELP("TYPE")="PI",$D(^AUPNPRVT("C",AGELP("PH"),AGELP("PDFN"))) G DISP
D ADD^AGEL1
S ADDCHK=""
DISP ;EP
I '$D(AGNEWINS) S AGELP("SAME")=0,AGELP("MODE")="E" D DISP^AGEL0
I $D(AGNEWINS) S AGELP("SAME")=0,AGELP("MODE")="A" D DISP^AGEL0
XIT S:$G(DFN)'=$G(AGELP("PDFN")) DFN=$G(AGELP("PDFN"))
K AGEL,AGV,DIC,DR
Q
AGEL ; IHS/ASDS/EFG - Add/Edit Eligibility Information ;
+1 ;;7.1;PATIENT REGISTRATION;**1,2,12**;AUG 25, 2005;Build 1
+2 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
+3 ;
HEAD SET U="^"
INS ;EP - EDIT AN INSURER
+1 IF $DATA(AGNEWINS)
GOTO INS2
+2 WRITE !!
+3 KILL DIC
+4 SET DIC="^AUTNINS("
SET DIC(0)="AEMQ"
SET DIC("A")="Select INSURER: "
+5 ;IHS/OIT/NKD AG*7.1*12 - START OLD CODE
+6 ;I $G(AGELP("TYPE"))="PI" S DIC("S")="I $D(^(1)),$P(^(1),U,7),$P(^(0),U)'=""MEDICAID"",$D(^(2)),""NRDI""'[$P(^(2),U)"
+7 ;E S DIC("S")="I $D(^(1)),$P(^(1),U,7),$D(^(2)),""NDR""'[$P(^(2),U)"
+8 ;IHS/OIT/NKD AG*7.1*12 - END OLD CODE - START NEW CODE
+9 IF $GET(AGELP("TYPE"))="PI"
SET DIC("S")="I $D(^(1)),$P(^(1),U,7),$P(^(0),U)'=""MEDICAID"",""NRDI""'[$$INSTYP^AGUTL(Y)"
+10 IF '$TEST
SET DIC("S")="I $D(^(1)),$P(^(1),U,7),""NDR""'[$$INSTYP^AGUTL(Y)"
+11 ;IHS/OIT/NKD AG*7.1*12 - END NEW CODE
+12 KILL DTOUT,DUOUT
+13 DO ^DIC
+14 IF X=""!$DATA(DTOUT)!$DATA(DUOUT)
GOTO XIT
IF Y=-1
GOTO INS
+15 SET AGELP("INS")=+Y
+16 GOTO PH
INS2 ;
+1 IF $DATA(AGELP("PDFN"))
IF $DATA(^AUPNPRVT("I",AGELP("INS"),AGELP("PDFN")))
WRITE *7,!!,"WARNING: If you proceed you will be ADDING an Insurer that the Patient already",!," has an Eligibility Record for!"
+2 KILL DTOUT,DUOUT
+3 IF $TEST
WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")=" Do you wish to proceed"
DO ^DIR
KILL DIR
IF Y=1
WRITE " (OK, then proceed with caution)"
+4 IF Y=0!$DATA(DTOUT)!$DATA(DIRUT)!(Y="^")
GOTO XIT
PH KILL AGEL
+1 FOR AGEL="PH","TYPE","INS","MODE","PDFN","HRN"
IF $DATA(AGELP(AGEL))
SET AGEL(AGEL)=AGELP(AGEL)
+2 KILL AGELP
+3 FOR AGEL="PH","TYPE","INS","MODE","PDFN","HRN"
IF $DATA(AGEL(AGEL))
SET AGELP(AGEL)=AGEL(AGEL)
+4 KILL AGEL
+5 WRITE !!,"Enter the NAME of the POLICY HOLDER or the POLICY NUMBER if it already exists."
+6 IF $DATA(AGELP("PDFN"))
WRITE !?10,"(Enter 'SAME' if the PATIENT is the Policy Holder.)"
+7 KILL DIR
+8 WRITE !
+9 SET DIR(0)="FO^1:30"
SET DIR("A")="Select POLICY HOLDER"
SET AGEL("D")="^AUPN3PPH("
SET AGEL("D0")="QZEM"
SET AGEL("DS")="I $P(^(0),U,3)=AGELP(""INS"")"
IF $DATA(AGELP("TYPE"))
IF AGELP("TYPE")="MCD"
IF $DATA(AG("NUM"))
SET AGEL("DS")=AGEL("DS")_",$P(^(0),U,4)=AG(""NUM"")"
+10 SET DIR("?",1)="Enter Name of the person in whose name the account is carried or"
+11 SET DIR("?",2)="the Policy Number if the Policy already exists."
+12 SET DIR("?",3)=""
+13 SET DIR("?")="(NOTE: Existing Policy Holders are displayed by entering ""??"")"
+14 SET DIR("??")="^S X=""??"",DIC=AGEL(""D""),DIC(0)=AGEL(""D0""),DIC(""S"")=AGEL(""DS"") D ^DIC"
+15 DO ^DIR
+16 IF Y="/.,"!(Y="^^")
SET DFOUT=""
+17 IF Y=""
SET DLOUT=""
+18 IF Y="^"
SET (DUOUT,Y)=""
+19 IF Y?1"?".E!(Y["^")
SET (DQOUT,Y)=""
+20 KILL DIR
+21 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)
WRITE !!,"Not adding insurer...."
HANG 2
GOTO XIT
+22 IF $DATA(AGELP("PDFN"))
IF X="SAME"!(X="SELF")
SET (Y,X)=$PIECE(^DPT(AGELP("PDFN"),0),U)
SET AGELP("SAME")=1
DO PCHK^AGEL1
GOTO HIT
+23 IF '$TEST
SET AGELP("SAME")=0
+24 SET AGEL("X")=X
+25 ;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 18
+26 IF $GET(AGELP("INS"))
Begin DoDot:1
+27 NEW INSTYP,INSNM
+28 ;S INSTYP=$P($G(^AUTNINS(AGELP("INS"),2)),U)
+29 ;IHS/OIT/NKD AG*7.1*12
SET INSTYP=$$INSTYP^AGUTL(AGELP("INS"))
+30 SET INSNM=$PIECE($GET(^AUTNINS(AGELP("INS"),0)),U)
End DoDot:1
+31 ;END NEW CODE
+32 WRITE !
+33 KILL DIC
+34 SET DIC(0)="EM"
SET DIC="^AUPN3PPH("
SET DIC("S")="I $P(^(0),U,3)=AGELP(""INS"")"
+35 DO ^DIC
+36 IF +Y<1
DO PCHK^AGEL1
IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)
GOTO XIT
IF +Y<1
GOTO INS
HIT SET AGELP("PH")=+Y
SET AGELP("Y")=Y
+1 IF $PIECE(^AUPN3PPH(+Y,0),U,2)]""
SET AGELP("PHPAT")=$PIECE(^(0),U,2)
+2 SET AGELP("MODE")="E"
IF $PIECE(Y,U,3)=1
SET AGELP("MODE")="A"
+3 IF $DATA(AGELP("PDFN"))
IF AGELP("TYPE")="MCD"
IF 0
SET AGEL("I")=""
FOR AGZ("I")=1:1
SET AGEL("I")=$ORDER(^AUPNMCD("C",AGELP("PH"),AGEL("I")))
IF '+AGEL("I")
QUIT
IF $PIECE(^AUPNMCD(AGEL("I"),0),U)=AGELP("PDFN")
QUIT
+4 IF $TEST
GOTO DISP
+5 IF $DATA(AGELP("PDFN"))
IF AGELP("TYPE")="PI"
IF $DATA(^AUPNPRVT("C",AGELP("PH"),AGELP("PDFN")))
GOTO DISP
+6 DO ADD^AGEL1
+7 SET ADDCHK=""
DISP ;EP
+1 IF '$DATA(AGNEWINS)
SET AGELP("SAME")=0
SET AGELP("MODE")="E"
DO DISP^AGEL0
+2 IF $DATA(AGNEWINS)
SET AGELP("SAME")=0
SET AGELP("MODE")="A"
DO DISP^AGEL0
XIT IF $GET(DFN)'=$GET(AGELP("PDFN"))
SET DFN=$GET(AGELP("PDFN"))
+1 KILL AGEL,AGV,DIC,DR
+2 QUIT
