AGEL4.m

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