AGEL1.m

AGEL1 ; IHS/ASDS/EFG - Add/Edit Eligibility Information ;

 ;;7.1;PATIENT REGISTRATION;**1,2,4,12**;AUG 25, 2005;Build 1

 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE

 ;

ADD ;EP - PROMPT TO ADD DATA TO FLDS

 ;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 12

 I '$D(AGELP("PDFN")) D  Q:+Y<0

 .K DIC,DIE,DIR

 .S DIC(0)="AEMQ"

 .S DIC="^AUPNPAT("

 .D ^DIC

 .I Y S AGELP("PDFN")=+Y

 ;END NEW CODE

 ;W ! I $D(AGELP("PDFN")),'AGELP("SAME") S DIC="^AUTTRLSH(",DIC(0)="AQEM",DIC("S")="I $P(^(0),U,2)]""""",DIC("A")="Select RELATIONSHIP to the POLICY HOLDER: " D ^DIC G ADD:+Y<1 S AGELP("RELSH")=+Y

 S Y=AGELP("Y"),AGV("X2")=AGELP("PH")_";"_$P(^AUPN3PPH(AGELP("PH"),0),U),AGEL("X3")="" D ^AGELE2X2

 S DIE="^AUPN3PPH(",DA=AGELP("PH"),DR=".02////^S X=AGELP(""PDFN"")" D ^DIE

 S:$D(AG("PH9")) $P(^AUPN3PPH(AGELP("PH"),0),U,9)=AG("PH9")

 S:$D(AG("PH11")) $P(^AUPN3PPH(AGELP("PH"),0),U,11)=AG("PH11")

 S:$D(AG("PH12")) $P(^AUPN3PPH(AGELP("PH"),0),U,12)=AG("PH12")

 S:$D(AG("PH13")) $P(^AUPN3PPH(AGELP("PH"),0),U,13)=AG("PH13")

 S:$D(AG("PH14")) $P(^AUPN3PPH(AGELP("PH"),0),U,14)=AG("PH14")

 K AG("PH9"),AG("PH11"),AG("PH12"),AG("PH13"),AG("PH14")

 I AGELP("MODE")="A" W ! S AGELP("FLDS")="1,2,3,4,5,6,7,8,9,10,11" D EDLOOP^AGEL0

 I '$D(AGELP("PDFN")) S AGELP("SAME")=1

 S Y=$S($D(AGELP("PDFN")):AGELP("PDFN"),1:$P(^AUPN3PPH(AGELP("PH"),0),U,2)) D @($S($P($G(AGELP("TYPE")),U)="PI":"VENT^AGEL3",1:"DENT^AGEL2"))

 I '$D(AGELP("PDFN"))!(AGELP("MODE")="E") S AGELP("SAME")=0 K AGELP("RELSH") Q

 I $P($G(^AUPN3PPH(AGELP("PH"),0)),U,2)]"",AGELP("PDFN")'=$P(^(0),U,2) S AGELP("SAME")=1,Y=$P(^(0),U,2) D @($S($P(AGELP("TYPE"),U)="PI":"VENT^AGEL3",1:"DENT^AGEL2"))

 S AGELP("SAME")=0,AGELP("MODE")="E" K AGELP("RELSH")

 Q

SCAN K DIC S DIC(0)="QZEAM",DIC="^DPT(" D ^DIC

 Q:Y<0

 I $D(DUOUT)!$D(DTOUT) S Y=-1 Q

 I +Y<0 S X=AGEL("X") G CHK

 S AGEL("Y")=Y

 W ! K DIR S DIR(0)="Y",DIR("B")="Y",DIR("A")="Is "_Y(0,0)_" the Policy Holder (Y/N)" D ^DIR K DIR

 G SCAN:$D(DUOUT)!$D(DTOUT)!(Y'=1)

 S Y=AGEL("Y"),(AGEL("X"),X)=$P(^DPT(+Y,0),U) D HIT G PADD2

PCHK ;EP - LOOK FOR NAME IN POLICY HOLDER FILE

 I AGELP("SAME") S Y=AGELP("PDFN")_U_$P(^DPT(DFN,0),U) D HIT G PADD2

 W !!,"No Hit Found in POLICY HOLDER file",!!,"Searching PATIENT file ...."

 K DIC S DIC="^DPT(",DIC(0)="EM" D ^DIC

 S AGEL("DR")="",X=AGEL("X")

 I Y=-1 W !!,"No Hit Found in PATIENT File for ",AGEL("X"),"!" W ! K DIR S DIR(0)="Y",DIR("A")="Want to SCAN the PATIENT DATA BASE using Different Names" D ^DIR K DIR G SCAN:Y=1 S X=AGEL("X") G CHK

 W "   ",$P(Y,U,2)

PAT ;

 ;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 18

 N NOADD

 I $$ISMINOR^AGUTILS(DFN) D  I NOADD K NOADD Q

 .;IS IT SPECIFIC TO TYPE OF INSURER?

 .N INSNM,INSTYP

 .S NOADD=0

 .S INSNM=$P($G(^AUTNINS(AGELP("INS"),0)),U)

 .;S INSTYP=$P($G(^AUTNINS(AGELP("INS"),2)),U)

 .S INSTYP=$$INSTYP^AGUTL(AGELP("INS"))  ;IHS/OIT/NKD AG*7.1*12

 .I INSNM[("MEDICARE")!(INSNM[("RAILROAD RETIREMENT")) S NOADD=1

 .I INSTYP'="R" S NOADD=1

 .I AGELP("INS")=1 S NOADD=1

 .I NOADD W !,"A MINOR CANNOT BE THE POLICY HOLDER FOR "_$G(INSNM) H 3 Q

 K NOADD

 ;END NEW CODE

 S AGEL("Y")=Y W !!,"Is ",$P(Y,U,2)," the correct insured policy holder"

 S %=1 D YN^DICN I %<1 W *7 G PAT

 ;I %=1 S Y=AGEL("Y"),(AGEL("X"),X)=$P(^DPT(+Y,0),U) D HIT G PADD2

 I %=1 S Y=AGEL("Y"),(AGEL("X"),X)=$P($G(^DPT(+Y,0)),U) D HIT G PADD2  ;IHS/SD/TPF AG*7.1*4 NO IM

CHK K:X[""""!(X'?1U.UNP)!(X'[",")!(X?.E1","." ")!(X?.E1","." "1",".E)!($L(X,",")>3)!($L(X)>30)!($L(X)<3) X I $D(X) F L=1:0 S L=$F(X," ",L) Q:L=0  S:$E(X,L-2)?1P!($E(X,L)?1P)!(L>$L(X)) X=$E(X,1,L-2)_$E(X,L,99),L=L-1

 I '$D(X) W !!?10,"No Lookup Match Found, or Improper Format for New Entry" S Y=-1 Q

PADD W !!,"Do you wish to add ",X," as the Insured Policy Holder"

 S %=1 D YN^DICN I %'=1 K X S Y=-1 Q

PADD2 S DIC="^AUPN3PPH(",DIC(0)="L" K DD,DO D FILE^DICN Q:+Y<1

 S AGEL("Y")=Y,AGEL("X")=$P(Y,U,2)

 S DIE="^AUPN3PPH(",DR=AGEL("DR")_".03////"_AGELP("INS"),DA=+Y D ^DIE

 S X=AGEL("X"),Y=AGEL("Y")

 Q

HIT I $D(^DPT(+Y,0)) S X=$P(^(0),U),AGEL("DR")=+Y,AGEL("DR")=".02////"_AGEL("DR")_";.08////"_$P(^(0),U,2)_";.19////"_$P(^(0),U,3)_";"

 Q

AGEL1     ; IHS/ASDS/EFG - Add/Edit Eligibility Information ;

 +1       ;;7.1;PATIENT REGISTRATION;**1,2,4,12**;AUG 25, 2005;Build 1

 +2       ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE

 +3       ;

ADD       ;EP - PROMPT TO ADD DATA TO FLDS

 +1       ;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 12

 +2        IF '$DATA(AGELP("PDFN"))

               Begin DoDot:1

 +3                KILL DIC,DIE,DIR

 +4                SET DIC(0)="AEMQ"

 +5                SET DIC="^AUPNPAT("

 +6                DO ^DIC

 +7                IF Y

                       SET AGELP("PDFN")=+Y

               End DoDot:1

               IF +Y<0

                   QUIT 

 +8       ;END NEW CODE

 +9       ;W ! I $D(AGELP("PDFN")),'AGELP("SAME") S DIC="^AUTTRLSH(",DIC(0)="AQEM",DIC("S")="I $P(^(0),U,2)]""""",DIC("A")="Select RELATIONSHIP to the POLICY HOLDER: " D ^DIC G ADD:+Y<1 S AGELP("RELSH")=+Y

 +10       SET Y=AGELP("Y")

           SET AGV("X2")=AGELP("PH")_";"_$PIECE(^AUPN3PPH(AGELP("PH"),0),U)

           SET AGEL("X3")=""

           DO ^AGELE2X2

 +11       SET DIE="^AUPN3PPH("

           SET DA=AGELP("PH")

           SET DR=".02////^S X=AGELP(""PDFN"")"

           DO ^DIE

 +12       IF $DATA(AG("PH9"))

               SET $PIECE(^AUPN3PPH(AGELP("PH"),0),U,9)=AG("PH9")

 +13       IF $DATA(AG("PH11"))

               SET $PIECE(^AUPN3PPH(AGELP("PH"),0),U,11)=AG("PH11")

 +14       IF $DATA(AG("PH12"))

               SET $PIECE(^AUPN3PPH(AGELP("PH"),0),U,12)=AG("PH12")

 +15       IF $DATA(AG("PH13"))

               SET $PIECE(^AUPN3PPH(AGELP("PH"),0),U,13)=AG("PH13")

 +16       IF $DATA(AG("PH14"))

               SET $PIECE(^AUPN3PPH(AGELP("PH"),0),U,14)=AG("PH14")

 +17       KILL AG("PH9"),AG("PH11"),AG("PH12"),AG("PH13"),AG("PH14")

 +18       IF AGELP("MODE")="A"

               WRITE !

               SET AGELP("FLDS")="1,2,3,4,5,6,7,8,9,10,11"

               DO EDLOOP^AGEL0

 +19       IF '$DATA(AGELP("PDFN"))

               SET AGELP("SAME")=1

 +20       SET Y=$SELECT($DATA(AGELP("PDFN")):AGELP("PDFN"),1:$PIECE(^AUPN3PPH(AGELP("PH"),0),U,2))

           DO @($SELECT($PIECE($GET(AGELP("TYPE")),U)="PI":"VENT^AGEL3",1:"DENT^AGEL2"))

 +21       IF '$DATA(AGELP("PDFN"))!(AGELP("MODE")="E")

               SET AGELP("SAME")=0

               KILL AGELP("RELSH")

               QUIT 

 +22       IF $PIECE($GET(^AUPN3PPH(AGELP("PH"),0)),U,2)]""

               IF AGELP("PDFN")'=$PIECE(^(0),U,2)

                   SET AGELP("SAME")=1

                   SET Y=$PIECE(^(0),U,2)

                   DO @($SELECT($PIECE(AGELP("TYPE"),U)="PI":"VENT^AGEL3",1:"DENT^AGEL2"))

 +23       SET AGELP("SAME")=0

           SET AGELP("MODE")="E"

           KILL AGELP("RELSH")

 +24       QUIT 

SCAN       KILL DIC

           SET DIC(0)="QZEAM"

           SET DIC="^DPT("

           DO ^DIC

 +1        IF Y<0

               QUIT 

 +2        IF $DATA(DUOUT)!$DATA(DTOUT)

               SET Y=-1

               QUIT 

 +3        IF +Y<0

               SET X=AGEL("X")

               GOTO CHK

 +4        SET AGEL("Y")=Y

 +5        WRITE !

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="Y"

           SET DIR("A")="Is "_Y(0,0)_" the Policy Holder (Y/N)"

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DUOUT)!$DATA(DTOUT)!(Y'=1)

               GOTO SCAN

 +7        SET Y=AGEL("Y")

           SET (AGEL("X"),X)=$PIECE(^DPT(+Y,0),U)

           DO HIT

           GOTO PADD2

PCHK      ;EP - LOOK FOR NAME IN POLICY HOLDER FILE

 +1        IF AGELP("SAME")

               SET Y=AGELP("PDFN")_U_$PIECE(^DPT(DFN,0),U)

               DO HIT

               GOTO PADD2

 +2        WRITE !!,"No Hit Found in POLICY HOLDER file",!!,"Searching PATIENT file ...."

 +3        KILL DIC

           SET DIC="^DPT("

           SET DIC(0)="EM"

           DO ^DIC

 +4        SET AGEL("DR")=""

           SET X=AGEL("X")

 +5        IF Y=-1

               WRITE !!,"No Hit Found in PATIENT File for ",AGEL("X"),"!"

               WRITE !

               KILL DIR

               SET DIR(0)="Y"

               SET DIR("A")="Want to SCAN the PATIENT DATA BASE using Different Names"

               DO ^DIR

               KILL DIR

               IF Y=1

                   GOTO SCAN

               SET X=AGEL("X")

               GOTO CHK

 +6        WRITE "   ",$PIECE(Y,U,2)

PAT       ;

 +1       ;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 18

 +2        NEW NOADD

 +3        IF $$ISMINOR^AGUTILS(DFN)

               Begin DoDot:1

 +4       ;IS IT SPECIFIC TO TYPE OF INSURER?

 +5                NEW INSNM,INSTYP

 +6                SET NOADD=0

 +7                SET INSNM=$PIECE($GET(^AUTNINS(AGELP("INS"),0)),U)

 +8       ;S INSTYP=$P($G(^AUTNINS(AGELP("INS"),2)),U)

 +9       ;IHS/OIT/NKD AG*7.1*12

                   SET INSTYP=$$INSTYP^AGUTL(AGELP("INS"))

 +10               IF INSNM[("MEDICARE")!(INSNM[("RAILROAD RETIREMENT"))

                       SET NOADD=1

 +11               IF INSTYP'="R"

                       SET NOADD=1

 +12               IF AGELP("INS")=1

                       SET NOADD=1

 +13               IF NOADD

                       WRITE !,"A MINOR CANNOT BE THE POLICY HOLDER FOR "_$GET(INSNM)

                       HANG 3

                       QUIT 

               End DoDot:1

               IF NOADD

                   KILL NOADD

                   QUIT 

 +14       KILL NOADD

 +15      ;END NEW CODE

 +16       SET AGEL("Y")=Y

           WRITE !!,"Is ",$PIECE(Y,U,2)," the correct insured policy holder"

 +17       SET %=1

           DO YN^DICN

           IF %<1

               WRITE *7

               GOTO PAT

 +18      ;I %=1 S Y=AGEL("Y"),(AGEL("X"),X)=$P(^DPT(+Y,0),U) D HIT G PADD2

 +19      ;IHS/SD/TPF AG*7.1*4 NO IM

           IF %=1

               SET Y=AGEL("Y")

               SET (AGEL("X"),X)=$PIECE($GET(^DPT(+Y,0)),U)

               DO HIT

               GOTO PADD2

CHK        IF X[""""!(X'?1U.UNP)!(X'[",")!(X?.E1","." ")!(X?.E1","." "1",".E)!($LENGTH(X,",")>3)!($LENGTH(X)>30)!($LENGTH(X)<3)

               KILL X

           IF $DATA(X)

               FOR L=1:0

                   SET L=$FIND(X," ",L)

                   IF L=0

                       QUIT 

                   IF $EXTRACT(X,L-2)?1P!($EXTRACT(X,L)?1P)!(L>$LENGTH(X))

                       SET X=$EXTRACT(X,1,L-2)_$EXTRACT(X,L,99)

                       SET L=L-1

 +1        IF '$DATA(X)

               WRITE !!?10,"No Lookup Match Found, or Improper Format for New Entry"

               SET Y=-1

               QUIT 

PADD       WRITE !!,"Do you wish to add ",X," as the Insured Policy Holder"

 +1        SET %=1

           DO YN^DICN

           IF %'=1

               KILL X

               SET Y=-1

               QUIT 

PADD2      SET DIC="^AUPN3PPH("

           SET DIC(0)="L"

           KILL DD,DO

           DO FILE^DICN

           IF +Y<1

               QUIT 

 +1        SET AGEL("Y")=Y

           SET AGEL("X")=$PIECE(Y,U,2)

 +2        SET DIE="^AUPN3PPH("

           SET DR=AGEL("DR")_".03////"_AGELP("INS")

           SET DA=+Y

           DO ^DIE

 +3        SET X=AGEL("X")

           SET Y=AGEL("Y")

 +4        QUIT 

HIT        IF $DATA(^DPT(+Y,0))

               SET X=$PIECE(^(0),U)

               SET AGEL("DR")=+Y

               SET AGEL("DR")=".02////"_AGEL("DR")_";.08////"_$PIECE(^(0),U,2)_";.19////"_$PIECE(^(0),U,3)_";"

 +1        QUIT