AGELA ; IHS/ASDS/EFG - Add/Edit Eligibility Display ;
;;7.1;PATIENT REGISTRATION;**11,12**;AUG 25,2005;Build 1
;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX
;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
;
;ALLOW PROPER EXIT FROM PRIVATE SCREEN AFTER DELETING ENTRY
Q:$G(AGELP("PH"))=""
I '$D(^AUPN3PPH(AGELP("PH"))) D
.S $P(^AUPN3PPH(AGELP("PH"),0),U)="VALIDATE"
.S $P(^AUPN3PPH(AGELP("PH"),0),U,2)=$G(AGELP("PI"))
.S $P(^AUPN3PPH(AGELP("PH"),0),U,3)=$G(AGELP("INS"))
S AGV("X2")=AGELP("PH")_";"_$P(^AUPN3PPH(AGELP("PH"),0),U)
S AGV("X3")=""
D ^AGELE2X2
K AGE
I $P(^AUPN3PPH(AGELP("PH"),0),U,2)]"" S AGELP("PHPAT")=$P(^(0),U,2)
E I $P(^AUPN3PPH(AGELP("PH"),0),U,16)]"" S AGELP("EMPL")=$P(^(0),U,16)
I '$D(IOF) D HOME^%ZIS
;header
HDR W $$S^AGVDF("IOF")
S AG("PG")="4PVTA"
S ROUTID=$P($T(+1)," ")
D PROGVIEW^AGUTILS(DUZ)
W !
W "IHS REGISTRATION ",$S($D(AGSEENLY):"VIEW SCREEN",1:"EDITOR")
W ?33,"Private Insurance"
W ?80-$L($P(^DIC(4,DUZ(2),0),U)),$P(^DIC(4,DUZ(2),0),U)
S AGLINE("-")=$TR($J(" ",80)," ","-")
S AGLINE("EQ")=$TR($J(" ",80)," ","=")
W !,AGLINE("EQ")
I $G(AGPAT)'="" W !,$E(AGPAT,1,23)
E W !,$E($P($G(^DPT(DFN,0)),U),1,23)
I $G(AGUPDT)'="" W ?23,AGUPDT
I $G(AGCHRT)'="" W ?42,"HRN#:",AGCHRT
E W ?42,"HRN#:",$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
S AGELSTS=$P($G(^AUPNPAT(DFN,11)),U,12)
W ?56,"(",$S(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PENDING VERIFICATION",1:"NONE"),")"
W !,AGLINE("EQ")
K DR,DIE,AG("ED"),AGDTS
DATA W !,"1) Policy Holder.: ",$E($P(^AUPN3PPH(AGELP("PH"),0),U),1,20) S AGEL("P")=$P(^(0),U,2)
I AGEL("P")]"",'$D(^DPT(AGEL("P"),0)) S AGEL("P")=""
I AGEL("P")="" W " [NOT REG]"
;IHS/OIT/NKD AG*7.1*11 MU2 - STANDARDIZED DISPLAY OF GENDER - START NEW CODE
;W ?50,"|5) Gender (M/F): "
;W $S($P(AGV("X2"),U,6)="M":"MALE",$P(AGV("X2"),U,6)="F":"FEMALE",1:"")
W ?50,"|5) Gender: "
W $S($P(AGV("X2"),U,6)="M":"MALE",$P(AGV("X2"),U,6)="F":"FEMALE",$P(AGV("X2"),U,6)="U":"UNKNOWN",1:"")
;IHS/OIT/NKD AG*7.1*11 END NEW CODE
W !,"2) Policy or SSN.: ",$P(^AUPN3PPH(AGELP("PH"),0),U,4)
W ?50,"|6) Date of Birth: "
S AGEL("DT")=$P(AGV("X2"),U,7)
D DT
W AGEL("DT")
W !,"3) Effective Date: "
S AGEL("DT")=$P(^AUPN3PPH(AGELP("PH"),0),U,17)
D DT
W AGEL("DT")
W ?50,"|7) Prim care Prov: "
K PRVTNODE
I $G(AGSELECT)'="" S PRVTNODE=$P($G(AGSELECT),U,11),PRVTNODE="^AUPNPRVT("_PRVTNODE_")"
E I $G(AGREC)'="" S PRVTNODE="^AUPNPRVT("_DFN_",11,"_AGREC_",0)"
I $G(PRVTNODE)'="" W $P($G(@PRVTNODE),U,14)
K PRVTNODE
W !,"4) Expire Date...: "
S AGEL("DT")=$P(^AUPN3PPH(AGELP("PH"),0),U,18)
D DT
W AGEL("DT")
W ?55,$$GET1^DIQ(9000006.11,$G(AGELP("INS"))_","_DFN_",",.14)
W !,"-HOLDER'S EMPLOYER INFO---------------------------------------------------------"
W !,"8) Status........: "
W $$GET1^DIQ(9000003.1,AGELP("PH"),.15)
W ?40,"| 9) Employer: "
W $$GET1^DIQ(9000003.1,AGELP("PH"),.16)
W !,"-INSURER INFORMATION-----------------------------------------------------------"
N AGINS
S AGINS=$S(AGELP("INS")'="":$G(^AUTNINS(AGELP("INS"),0)),1:"")
W !,$P(AGINS,U) ;insurer name
W ?40,"|10) Grp Name: "
I $P(^AUPN3PPH(AGELP("PH"),0),U,6)]"" D
.S AGEL("EGRP")=$P(^AUPN3PPH(AGELP("PH"),0),U,6)
.I $D(^AUTNEGRP(AGEL("EGRP"),0)) W $E($P(^(0),U),1,17)
E K AGEL("EGRP")
W !?2,$P(AGINS,U,2)
W ?40,"| Grp Number: "
I $D(AGEL("EGRP")),AGEL("EGRP")]"",$D(^AUTNEGRP(AGEL("EGRP"),0)) D
.W $E($S(+$O(^AUTNEGRP(AGEL("EGRP"),11,0)):"(Visit Specific)",1:$P(^AUTNEGRP(AGEL("EGRP"),0),U,2)),1,17)
W !?2,$P(AGINS,U,3)_", " ;insurer city
I $P(AGINS,U,4)'="" D
. W $P($G(^DIC(5,$P(AGINS,U,4),0)),U,2)_" " ;insurer state
E W " "
W $P(AGINS,U,5) ;insurer zip
W ?40,"|11) Coverage: "
I $P($G(^AUPN3PPH(AGELP("PH"),0)),U,5)]"",$D(^AUTTPIC($P(^(0),U,5),0)) W $E($P(^(0),U),1,17)
W !?2,$P(AGINS,U,6) ;insurer phone
W ?23,"Ins. Type: "
;W:$G(AGELP("INS"))'="" $P($G(^AUTNINS(AGELP("INS"),2)),U)
W:$G(AGELP("INS"))'="" $$INSTYP^AGUTL(AGELP("INS")) ;IHS/OIT/NKD AG*7.1*12
I '$G(AGEL("IN")) S AGEL("IN")=$G(AGELP("INS"))
S AGPRVIN0=$G(^AUPNPRVT(DFN,11,AGEL("IN"),0))
W ?40,"|12) CCopy: "
W $P(AGPRVIN0,U,15)
I $P($G(^AUPNPRVT(DFN,11,AGEL("IN"),0)),U,15)'="",$P($G(^AUPNPRVT(DFN,11,AGEL("IN"),0)),U,15)'="N" D
.W ?62,"Date: "
.S AGEL("DT")=$P(AGPRVIN0,U,16)
.D DT
.W AGEL("DT")
PHADD ;
E0 ;
E1 ;
E2 ;
MEM W !,"----Policy Members----PC-----Member #------HRN-----"
W "Rel----------From/Thru-------"
Q:$G(AGELP("INS"))=""
;S AGEL("DIC")=$S($P(^AUTNINS(AGELP("INS"),2),U)="D":"MCD",1:"PRVT")_"^AGELA1"
S AGEL("DIC")=$S($$INSTYP^AGUTL(AGELP("INS"))="D":"MCD",1:"PRVT")_"^AGELA1" ;IHS/OIT/NKD AG*7.1*12
D @AGEL("DIC")
S AGELP("FLDS")=AGEL("I")+11
W !
F J=1:1:80 W "="
K MYERRS,MYVARS
D FETCHERR^AGEDERR(AG("PG"),.MYERRS)
S MYVARS("DFN")=DFN,MYVARS("FINDCALL")="FINDPVT",MYVARS("SELECTION")=$G(AGSELECT),MYVARS("SITE")=DUZ(2)
D EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
W !,$G(AGLINE("-"))
D VERIF^AGUTILS
W !,$G(AGLINE("EQ"))
XIT ;
K ROUTID
Q
DT ;
I AGEL("DT")]"" S AGEL("DT")=$$FMTE^XLFDT(AGEL("DT"),5)
Q
AGELA ; IHS/ASDS/EFG - Add/Edit Eligibility Display ;
+1 ;;7.1;PATIENT REGISTRATION;**11,12**;AUG 25,2005;Build 1
+2 ;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX
+3 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
+4 ;
+5 ;ALLOW PROPER EXIT FROM PRIVATE SCREEN AFTER DELETING ENTRY
+6 IF $GET(AGELP("PH"))=""
QUIT
+7 IF '$DATA(^AUPN3PPH(AGELP("PH")))
Begin DoDot:1
+8 SET $PIECE(^AUPN3PPH(AGELP("PH"),0),U)="VALIDATE"
+9 SET $PIECE(^AUPN3PPH(AGELP("PH"),0),U,2)=$GET(AGELP("PI"))
+10 SET $PIECE(^AUPN3PPH(AGELP("PH"),0),U,3)=$GET(AGELP("INS"))
End DoDot:1
+11 SET AGV("X2")=AGELP("PH")_";"_$PIECE(^AUPN3PPH(AGELP("PH"),0),U)
+12 SET AGV("X3")=""
+13 DO ^AGELE2X2
+14 KILL AGE
+15 IF $PIECE(^AUPN3PPH(AGELP("PH"),0),U,2)]""
SET AGELP("PHPAT")=$PIECE(^(0),U,2)
+16 IF '$TEST
IF $PIECE(^AUPN3PPH(AGELP("PH"),0),U,16)]""
SET AGELP("EMPL")=$PIECE(^(0),U,16)
+17 IF '$DATA(IOF)
DO HOME^%ZIS
+18 ;header
HDR WRITE $$S^AGVDF("IOF")
+1 SET AG("PG")="4PVTA"
+2 SET ROUTID=$PIECE($TEXT(+1)," ")
+3 DO PROGVIEW^AGUTILS(DUZ)
+4 WRITE !
+5 WRITE "IHS REGISTRATION ",$SELECT($DATA(AGSEENLY):"VIEW SCREEN",1:"EDITOR")
+6 WRITE ?33,"Private Insurance"
+7 WRITE ?80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U)),$PIECE(^DIC(4,DUZ(2),0),U)
+8 SET AGLINE("-")=$TRANSLATE($JUSTIFY(" ",80)," ","-")
+9 SET AGLINE("EQ")=$TRANSLATE($JUSTIFY(" ",80)," ","=")
+10 WRITE !,AGLINE("EQ")
+11 IF $GET(AGPAT)'=""
WRITE !,$EXTRACT(AGPAT,1,23)
+12 IF '$TEST
WRITE !,$EXTRACT($PIECE($GET(^DPT(DFN,0)),U),1,23)
+13 IF $GET(AGUPDT)'=""
WRITE ?23,AGUPDT
+14 IF $GET(AGCHRT)'=""
WRITE ?42,"HRN#:",AGCHRT
+15 IF '$TEST
WRITE ?42,"HRN#:",$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
+16 SET AGELSTS=$PIECE($GET(^AUPNPAT(DFN,11)),U,12)
+17 WRITE ?56,"(",$SELECT(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PENDING VERIFICATION",1:"NONE"),")"
+18 WRITE !,AGLINE("EQ")
+19 KILL DR,DIE,AG("ED"),AGDTS
DATA WRITE !,"1) Policy Holder.: ",$EXTRACT($PIECE(^AUPN3PPH(AGELP("PH"),0),U),1,20)
SET AGEL("P")=$PIECE(^(0),U,2)
+1 IF AGEL("P")]""
IF '$DATA(^DPT(AGEL("P"),0))
SET AGEL("P")=""
+2 IF AGEL("P")=""
WRITE " [NOT REG]"
+3 ;IHS/OIT/NKD AG*7.1*11 MU2 - STANDARDIZED DISPLAY OF GENDER - START NEW CODE
+4 ;W ?50,"|5) Gender (M/F): "
+5 ;W $S($P(AGV("X2"),U,6)="M":"MALE",$P(AGV("X2"),U,6)="F":"FEMALE",1:"")
+6 WRITE ?50,"|5) Gender: "
+7 WRITE $SELECT($PIECE(AGV("X2"),U,6)="M":"MALE",$PIECE(AGV("X2"),U,6)="F":"FEMALE",$PIECE(AGV("X2"),U,6)="U":"UNKNOWN",1:"")
+8 ;IHS/OIT/NKD AG*7.1*11 END NEW CODE
+9 WRITE !,"2) Policy or SSN.: ",$PIECE(^AUPN3PPH(AGELP("PH"),0),U,4)
+10 WRITE ?50,"|6) Date of Birth: "
+11 SET AGEL("DT")=$PIECE(AGV("X2"),U,7)
+12 DO DT
+13 WRITE AGEL("DT")
+14 WRITE !,"3) Effective Date: "
+15 SET AGEL("DT")=$PIECE(^AUPN3PPH(AGELP("PH"),0),U,17)
+16 DO DT
+17 WRITE AGEL("DT")
+18 WRITE ?50,"|7) Prim care Prov: "
+19 KILL PRVTNODE
+20 IF $GET(AGSELECT)'=""
SET PRVTNODE=$PIECE($GET(AGSELECT),U,11)
SET PRVTNODE="^AUPNPRVT("_PRVTNODE_")"
+21 IF '$TEST
IF $GET(AGREC)'=""
SET PRVTNODE="^AUPNPRVT("_DFN_",11,"_AGREC_",0)"
+22 IF $GET(PRVTNODE)'=""
WRITE $PIECE($GET(@PRVTNODE),U,14)
+23 KILL PRVTNODE
+24 WRITE !,"4) Expire Date...: "
+25 SET AGEL("DT")=$PIECE(^AUPN3PPH(AGELP("PH"),0),U,18)
+26 DO DT
+27 WRITE AGEL("DT")
+28 WRITE ?55,$$GET1^DIQ(9000006.11,$GET(AGELP("INS"))_","_DFN_",",.14)
+29 WRITE !,"-HOLDER'S EMPLOYER INFO---------------------------------------------------------"
+30 WRITE !,"8) Status........: "
+31 WRITE $$GET1^DIQ(9000003.1,AGELP("PH"),.15)
+32 WRITE ?40,"| 9) Employer: "
+33 WRITE $$GET1^DIQ(9000003.1,AGELP("PH"),.16)
+34 WRITE !,"-INSURER INFORMATION-----------------------------------------------------------"
+35 NEW AGINS
+36 SET AGINS=$SELECT(AGELP("INS")'="":$GET(^AUTNINS(AGELP("INS"),0)),1:"")
+37 ;insurer name
WRITE !,$PIECE(AGINS,U)
+38 WRITE ?40,"|10) Grp Name: "
+39 IF $PIECE(^AUPN3PPH(AGELP("PH"),0),U,6)]""
Begin DoDot:1
+40 SET AGEL("EGRP")=$PIECE(^AUPN3PPH(AGELP("PH"),0),U,6)
+41 IF $DATA(^AUTNEGRP(AGEL("EGRP"),0))
WRITE $EXTRACT($PIECE(^(0),U),1,17)
End DoDot:1
+42 IF '$TEST
KILL AGEL("EGRP")
+43 WRITE !?2,$PIECE(AGINS,U,2)
+44 WRITE ?40,"| Grp Number: "
+45 IF $DATA(AGEL("EGRP"))
IF AGEL("EGRP")]""
IF $DATA(^AUTNEGRP(AGEL("EGRP"),0))
Begin DoDot:1
+46 WRITE $EXTRACT($SELECT(+$ORDER(^AUTNEGRP(AGEL("EGRP"),11,0)):"(Visit Specific)",1:$PIECE(^AUTNEGRP(AGEL("EGRP"),0),U,2)),1,17)
End DoDot:1
+47 ;insurer city
WRITE !?2,$PIECE(AGINS,U,3)_", "
+48 IF $PIECE(AGINS,U,4)'=""
Begin DoDot:1
+49 ;insurer state
WRITE $PIECE($GET(^DIC(5,$PIECE(AGINS,U,4),0)),U,2)_" "
End DoDot:1
+50 IF '$TEST
WRITE " "
+51 ;insurer zip
WRITE $PIECE(AGINS,U,5)
+52 WRITE ?40,"|11) Coverage: "
+53 IF $PIECE($GET(^AUPN3PPH(AGELP("PH"),0)),U,5)]""
IF $DATA(^AUTTPIC($PIECE(^(0),U,5),0))
WRITE $EXTRACT($PIECE(^(0),U),1,17)
+54 ;insurer phone
WRITE !?2,$PIECE(AGINS,U,6)
+55 WRITE ?23,"Ins. Type: "
+56 ;W:$G(AGELP("INS"))'="" $P($G(^AUTNINS(AGELP("INS"),2)),U)
+57 ;IHS/OIT/NKD AG*7.1*12
IF $GET(AGELP("INS"))'=""
WRITE $$INSTYP^AGUTL(AGELP("INS"))
+58 IF '$GET(AGEL("IN"))
SET AGEL("IN")=$GET(AGELP("INS"))
+59 SET AGPRVIN0=$GET(^AUPNPRVT(DFN,11,AGEL("IN"),0))
+60 WRITE ?40,"|12) CCopy: "
+61 WRITE $PIECE(AGPRVIN0,U,15)
+62 IF $PIECE($GET(^AUPNPRVT(DFN,11,AGEL("IN"),0)),U,15)'=""
IF $PIECE($GET(^AUPNPRVT(DFN,11,AGEL("IN"),0)),U,15)'="N"
Begin DoDot:1
+63 WRITE ?62,"Date: "
+64 SET AGEL("DT")=$PIECE(AGPRVIN0,U,16)
+65 DO DT
+66 WRITE AGEL("DT")
End DoDot:1
PHADD ;
E0 ;
E1 ;
E2 ;
MEM WRITE !,"----Policy Members----PC-----Member #------HRN-----"
+1 WRITE "Rel----------From/Thru-------"
+2 IF $GET(AGELP("INS"))=""
QUIT
+3 ;S AGEL("DIC")=$S($P(^AUTNINS(AGELP("INS"),2),U)="D":"MCD",1:"PRVT")_"^AGELA1"
+4 ;IHS/OIT/NKD AG*7.1*12
SET AGEL("DIC")=$SELECT($$INSTYP^AGUTL(AGELP("INS"))="D":"MCD",1:"PRVT")_"^AGELA1"
+5 DO @AGEL("DIC")
+6 SET AGELP("FLDS")=AGEL("I")+11
+7 WRITE !
+8 FOR J=1:1:80
WRITE "="
+9 KILL MYERRS,MYVARS
+10 DO FETCHERR^AGEDERR(AG("PG"),.MYERRS)
+11 SET MYVARS("DFN")=DFN
SET MYVARS("FINDCALL")="FINDPVT"
SET MYVARS("SELECTION")=$GET(AGSELECT)
SET MYVARS("SITE")=DUZ(2)
+12 DO EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
+13 WRITE !,$GET(AGLINE("-"))
+14 DO VERIF^AGUTILS
+15 WRITE !,$GET(AGLINE("EQ"))
XIT ;
+1 KILL ROUTID
+2 QUIT
DT ;
+1 IF AGEL("DT")]""
SET AGEL("DT")=$$FMTE^XLFDT(AGEL("DT"),5)
+2 QUIT
