AGEL.m

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