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
