AGEL4 ; IHS/ASDS/EFG - Add/Edit Eligibility PART 4 ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
COV ;EP - PROMPT FOR COVERAGE TYPE
S DIE="^AUPN3PPH("
S DR=".05[11] Select COVERAGE TYPE: ",DA=AGELP("PH")
D ^DIE
K DIC
Q:$P(^AUPN3PPH(AGELP("PH"),0),U,5)=""!$D(Y)
S AGEL("COV")=$P(^AUPN3PPH(AGELP("PH"),0),U,5)
Q
H14 ;
S AGEL("OLDN")=$P(^AUTNEMPL(0),U,4)
S DIE="^AUPN3PPH("
S DR=".16[14] Select EMPLOYER: "
S DA=AGELP("PH")
D ^DIE
Q:$P(^AUPN3PPH(AGELP("PH"),0),U,16)=""!$D(Y) S AGEL("DFN")=$P(^(0),U,16)
Q:$P(^AUTNEMPL(0),U,4)=AGEL("OLDN")
EMPL S DIE="^AUTNEMPL(",DA=AGEL("DFN")
W !!,"<---------EDIT EMPLOYER DEMOGRAPHICS--------->"
S DR=".02 Street...: ;.03 City.....: ;.04 State....: "
S DR=DR_";.05 Zip......: ;.06 Phone....: "
D ^DIE
Q
P14 S AGEL("OLDN")=$P(^AUTNEMPL(0),U,4)
S DIE="^AUPN3PPH("
S DR=".16[14] Select EMPLOYER: ",DA=AGELP("PH")
D ^DIE
Q:$P(^AUPN3PPH(AGELP("PH"),0),U,16)=""!$D(Y) S AGEL("DFN")=$P(^(0),U,16)
Q:$P(^AUTNEMPL(0),U,4)=AGEL("OLDN")
G EMPL
GRP ;EP - PROMPT FOR GROUP FLDS
S AGEL("OLDN")=$P(^AUTNEGRP(0),U,4)
S DIE="^AUPN3PPH(",DR=".06[10] Select GROUP NAME: ",DA=AGELP("PH") D ^DIE
Q:$P(^AUPN3PPH(AGELP("PH"),0),U,6)=""!$D(Y) S AGEL("EGRP")=$P(^AUPN3PPH(AGELP("PH"),0),U,6)
Q:$P(^AUTNEGRP(0),U,4)=AGEL("OLDN")
W ! S DIE="^AUTNEGRP(",DA=AGEL("EGRP")
W !!?5 W "NOTE: Some Insurers assign different Group Numbers based upon the",!?11,"particular type of visit (dental, outpatient, etc.) that",!?11,"occurred."
W ! K DIR S DIR("B")="N",DIR(0)="Y",DIR("A")="Do the Group Numbers vary depending on Visit Type (Y/N)"
S DIR("B")=$S($D(^AUTNEGRP(AGEL("EGRP"),11)):"Y",1:"N") D ^DIR
Q:$D(DTOUT)!(Y="^") W !
I Y=0 S DIE="^AUTNEGRP(",DA=AGEL("EGRP"),DR=".02R~[5a] Group Number.....: " D ^DIE K ^AUTNEGRP(AGEL("EGRP"),11) Q
S DA=AGEL("EGRP"),DIE="^AUTNEGRP(",DR="11" D ^DIE
Q
CARDCOPY ;EP
Q:$G(AGELP("MODE"))="A"
S:$P($G(AGINSREC),U,11)'="" DA=$P($P(AGINSREC,U,11),",",3)
S DA(1)=$G(DFN)
S DIE="^AUPNPRVT("_DA(1)_",11,"
S DR=".15[12] Card Copy on file: "
D ^DIE
;I $G(DA(1)),$G(DA) I '$P($G(^AUPNPRVT(DA(1),11,DA,0)),U) K TESTVAR S X=TESTVAR
I $G(DA(1)),$G(DA) I '$P($G(^AUPNPRVT(DA(1),11,DA,0)),U) K ^AUPNPRVT(DA(1),11,DA,0)
I X="Y" D
.S DR=".16 Date CC obtained..: "
.D ^DIE
K DIE
Q
PRECERT ;
I $G(AUPNPAT)="" S AUPNPAT=AGELP("PDFN")
S DIC="^AUPNPCRT("
S DIC(0)="AELQMZ"
S DIC("S")="I $P($G(^AUPNPCRT(Y,0)),U,2)=$G(AUPNPAT)"
S DIC("A")="[8] Pre-Certification #.:"
S DIC("DR")=".02////^S X=AUPNPAT"
D ^DIC
K DIC("S")
Q:Y<0
S DIE=DIC
S DA=+Y,AGPCIEN=Y
S DR=".03 Pre-cert Date.: ;.04"
D ^DIE
K DIC,DIE
Q
PCCONTAC ;
Q:$G(AGPCIEN)=""
S DIE="^AUPNPCRT("
S DR=".04[9] Pre-cert Contact: "
S DA=+AGPCIEN
D ^DIE
K DIE
Q
PCP ;EP
Q:$G(AGELP("MODE"))="A"
;THERE IS NO PRVT ENTRY IN THE INSURER FILE WHEN THIS IS ENTERED
S:$P($G(AGINSREC),U,11)'="" DA=$P($P(AGINSREC,U,11),",",3)
S DA(1)=$G(DFN)
S DIE="^AUPNPRVT("_DA(1)_",11,"
S DR=".14[7] Primary Care Provider: "
D ^DIE
;I $G(DA(1)),$G(DA) I '$P($G(^AUPNPRVT(DA(1),11,DA,0)),U) K TESTVAR S X=TESTVAR
I $G(DA(1)),$G(DA) I '$P($G(^AUPNPRVT(DA(1),11,DA,0)),U) K ^AUPNPRVT(DA(1),11,DA,0)
K DIE
Q
ESTAT ;EP - PH EMPLOYMENT STATUS
S DIE="^AUPN3PPH("
S DA=AGELP("PH")
S DR=.15
D ^DIE
K DIE
Q
EMP ;EP - PH EMPLOYER
S DIE="^AUPN3PPH("
S DA=AGELP("PH")
S DR=.16
D ^DIE
K DIE
Q
PHSEX ;EP - PH GENDER
S DIE="^AUPN3PPH("
S DA=AGELP("PH")
S DR=.08
D ^DIE
K DIE
Q
PHDOB ;EP - PH DOB
S DIE="^AUPN3PPH("
S DA=AGELP("PH")
S DR=.19
D ^DIE
K DIE
Q
AGEL4 ; IHS/ASDS/EFG - Add/Edit Eligibility PART 4 ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
COV ;EP - PROMPT FOR COVERAGE TYPE
+1 SET DIE="^AUPN3PPH("
+2 SET DR=".05[11] Select COVERAGE TYPE: "
SET DA=AGELP("PH")
+3 DO ^DIE
+4 KILL DIC
+5 IF $PIECE(^AUPN3PPH(AGELP("PH"),0),U,5)=""!$DATA(Y)
QUIT
+6 SET AGEL("COV")=$PIECE(^AUPN3PPH(AGELP("PH"),0),U,5)
+7 QUIT
H14 ;
+1 SET AGEL("OLDN")=$PIECE(^AUTNEMPL(0),U,4)
+2 SET DIE="^AUPN3PPH("
+3 SET DR=".16[14] Select EMPLOYER: "
+4 SET DA=AGELP("PH")
+5 DO ^DIE
+6 IF $PIECE(^AUPN3PPH(AGELP("PH"),0),U,16)=""!$DATA(Y)
QUIT
SET AGEL("DFN")=$PIECE(^(0),U,16)
+7 IF $PIECE(^AUTNEMPL(0),U,4)=AGEL("OLDN")
QUIT
EMPL SET DIE="^AUTNEMPL("
SET DA=AGEL("DFN")
+1 WRITE !!,"<---------EDIT EMPLOYER DEMOGRAPHICS--------->"
+2 SET DR=".02 Street...: ;.03 City.....: ;.04 State....: "
+3 SET DR=DR_";.05 Zip......: ;.06 Phone....: "
+4 DO ^DIE
+5 QUIT
P14 SET AGEL("OLDN")=$PIECE(^AUTNEMPL(0),U,4)
+1 SET DIE="^AUPN3PPH("
+2 SET DR=".16[14] Select EMPLOYER: "
SET DA=AGELP("PH")
+3 DO ^DIE
+4 IF $PIECE(^AUPN3PPH(AGELP("PH"),0),U,16)=""!$DATA(Y)
QUIT
SET AGEL("DFN")=$PIECE(^(0),U,16)
+5 IF $PIECE(^AUTNEMPL(0),U,4)=AGEL("OLDN")
QUIT
+6 GOTO EMPL
GRP ;EP - PROMPT FOR GROUP FLDS
+1 SET AGEL("OLDN")=$PIECE(^AUTNEGRP(0),U,4)
+2 SET DIE="^AUPN3PPH("
SET DR=".06[10] Select GROUP NAME: "
SET DA=AGELP("PH")
DO ^DIE
+3 IF $PIECE(^AUPN3PPH(AGELP("PH"),0),U,6)=""!$DATA(Y)
QUIT
SET AGEL("EGRP")=$PIECE(^AUPN3PPH(AGELP("PH"),0),U,6)
+4 IF $PIECE(^AUTNEGRP(0),U,4)=AGEL("OLDN")
QUIT
+5 WRITE !
SET DIE="^AUTNEGRP("
SET DA=AGEL("EGRP")
+6 WRITE !!?5
WRITE "NOTE: Some Insurers assign different Group Numbers based upon the",!?11,"particular type of visit (dental, outpatient, etc.) that",!?11,"occurred."
+7 WRITE !
KILL DIR
SET DIR("B")="N"
SET DIR(0)="Y"
SET DIR("A")="Do the Group Numbers vary depending on Visit Type (Y/N)"
+8 SET DIR("B")=$SELECT($DATA(^AUTNEGRP(AGEL("EGRP"),11)):"Y",1:"N")
DO ^DIR
+9 IF $DATA(DTOUT)!(Y="^")
QUIT
WRITE !
+10 IF Y=0
SET DIE="^AUTNEGRP("
SET DA=AGEL("EGRP")
SET DR=".02R~[5a] Group Number.....: "
DO ^DIE
KILL ^AUTNEGRP(AGEL("EGRP"),11)
QUIT
+11 SET DA=AGEL("EGRP")
SET DIE="^AUTNEGRP("
SET DR="11"
DO ^DIE
+12 QUIT
CARDCOPY ;EP
+1 IF $GET(AGELP("MODE"))="A"
QUIT
+2 IF $PIECE($GET(AGINSREC),U,11)'=""
SET DA=$PIECE($PIECE(AGINSREC,U,11),",",3)
+3 SET DA(1)=$GET(DFN)
+4 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+5 SET DR=".15[12] Card Copy on file: "
+6 DO ^DIE
+7 ;I $G(DA(1)),$G(DA) I '$P($G(^AUPNPRVT(DA(1),11,DA,0)),U) K TESTVAR S X=TESTVAR
+8 IF $GET(DA(1))
IF $GET(DA)
IF '$PIECE($GET(^AUPNPRVT(DA(1),11,DA,0)),U)
KILL ^AUPNPRVT(DA(1),11,DA,0)
+9 IF X="Y"
Begin DoDot:1
+10 SET DR=".16 Date CC obtained..: "
+11 DO ^DIE
End DoDot:1
+12 KILL DIE
+13 QUIT
PRECERT ;
+1 IF $GET(AUPNPAT)=""
SET AUPNPAT=AGELP("PDFN")
+2 SET DIC="^AUPNPCRT("
+3 SET DIC(0)="AELQMZ"
+4 SET DIC("S")="I $P($G(^AUPNPCRT(Y,0)),U,2)=$G(AUPNPAT)"
+5 SET DIC("A")="[8] Pre-Certification #.:"
+6 SET DIC("DR")=".02////^S X=AUPNPAT"
+7 DO ^DIC
+8 KILL DIC("S")
+9 IF Y<0
QUIT
+10 SET DIE=DIC
+11 SET DA=+Y
SET AGPCIEN=Y
+12 SET DR=".03 Pre-cert Date.: ;.04"
+13 DO ^DIE
+14 KILL DIC,DIE
+15 QUIT
PCCONTAC ;
+1 IF $GET(AGPCIEN)=""
QUIT
+2 SET DIE="^AUPNPCRT("
+3 SET DR=".04[9] Pre-cert Contact: "
+4 SET DA=+AGPCIEN
+5 DO ^DIE
+6 KILL DIE
+7 QUIT
PCP ;EP
+1 IF $GET(AGELP("MODE"))="A"
QUIT
+2 ;THERE IS NO PRVT ENTRY IN THE INSURER FILE WHEN THIS IS ENTERED
+3 IF $PIECE($GET(AGINSREC),U,11)'=""
SET DA=$PIECE($PIECE(AGINSREC,U,11),",",3)
+4 SET DA(1)=$GET(DFN)
+5 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+6 SET DR=".14[7] Primary Care Provider: "
+7 DO ^DIE
+8 ;I $G(DA(1)),$G(DA) I '$P($G(^AUPNPRVT(DA(1),11,DA,0)),U) K TESTVAR S X=TESTVAR
+9 IF $GET(DA(1))
IF $GET(DA)
IF '$PIECE($GET(^AUPNPRVT(DA(1),11,DA,0)),U)
KILL ^AUPNPRVT(DA(1),11,DA,0)
+10 KILL DIE
+11 QUIT
ESTAT ;EP - PH EMPLOYMENT STATUS
+1 SET DIE="^AUPN3PPH("
+2 SET DA=AGELP("PH")
+3 SET DR=.15
+4 DO ^DIE
+5 KILL DIE
+6 QUIT
EMP ;EP - PH EMPLOYER
+1 SET DIE="^AUPN3PPH("
+2 SET DA=AGELP("PH")
+3 SET DR=.16
+4 DO ^DIE
+5 KILL DIE
+6 QUIT
PHSEX ;EP - PH GENDER
+1 SET DIE="^AUPN3PPH("
+2 SET DA=AGELP("PH")
+3 SET DR=.08
+4 DO ^DIE
+5 KILL DIE
+6 QUIT
PHDOB ;EP - PH DOB
+1 SET DIE="^AUPN3PPH("
+2 SET DA=AGELP("PH")
+3 SET DR=.19
+4 DO ^DIE
+5 KILL DIE
+6 QUIT
