AGPHADDR ; IHS/ASDS/EFG - DISPLAY/EDIT POLICY HOLDER ADDR/MEMBERS ;
;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
;
;IHS/SD/TPF 9/15/2005 AG*7.1*1
;MODIFIED TO GET RID OF USE OF AGELP("PH")
;AND USE A PARAMETER INSTEAD
;
Q ;ADDED EN CALL IHS/SD/TPF 9/15/2005 AG*7.1*1
EN(POLHPTR) ;EP - DISPLAY/EDIT POLICY HOLDER ADDR/MEMBERS IHS/SD/TPF 9/15/2005 AG*7.1*1
I 'POLHPTR W !,"POLICY HOLDER UNDEFINED FOR THIS ENTRY!" H 3 Q ;AG*7.1*1
K AG("FLDCNT")
I $D(AG("TMPMBR")) K AG("TMPMBR")
D FINDPH ;LOAD AG("TMPMBR") WITH POLICY HOLDER FIELDS
I Y="V" D ALLMBR ;DISPLAY FIELDS FOR ALL MEMBERS
I $L(Y)>1 D ONEMBR ;DISPLAY FIELDS FOR SELECTED MEMBER
VAR ;
D ^XBCLS
D HDR
D DRAW
Q:$D(AGSEENLY)
G END:$D(DLOUT)!($D(DUOUT))
Q:$D(DFOUT)!$D(DTOUT)
G VAR
END ;K AG("PH9"),AG("PH11"),AG("PH12"),AG("PH13"),AG("PH14"),DTOUT,DUOUT,DLOUT,DFOUT,DQOUT
K AG("PH9"),AG("PH11"),AG("PH12"),AG("PH13"),AG("PH14"),DTOUT,DUOUT,DLOUT,DQOUT ;DON'T KILL DFOUT - ^^ AND "/.," WON'T WORK
Q:$D(AGXTERN)
Q:$D(DIROUT)
Q:$D(AGSEENLY)
Q
HDR ;
I '$D(IOF) D HOME^%ZIS
W $$S^AGVDF("IOF"),!
W "IHS REGISTRATION ",$S($D(AGSEENLY):"VIEW SCREEN",1:"EDITOR")
W ?31,"Policy Holder View"
W ?78-$L($P($G(^DIC(4,DUZ(2),0)),U)),$P($G(^DIC(4,DUZ(2),0)),U)
S AGLINE("-")=$TR($J(" ",78)," ","-")
S AGLINE("EQ")=$TR($J(" ",78)," ","=")
W !,AGLINE("EQ")
I '$D(AGPAT) S AGPAT=$P($G(^DPT(DFN,0)),U)
W !,$E(AGPAT,1,23)
W ?36,$$DTEST^AGUTILS(DFN)
I $D(AGCHRT) W ?55,"HRN:",AGCHRT
I AG("PG")>1 D
. ;GET ELIGIBILITY STATUS
. S AGELSTS=$P($G(^AUPNPAT(DFN,11)),U,12)
. W ?66,$S(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PEND. VERIF",1:"NONE"),!
W AGLINE("EQ"),!
Q
DRAW ;EP
N DA
;S DA=AGELP("PH")
S DA=POLHPTR ;IHS/SD/TPF AG*7.1*1
K ^UTILITY("DIQ1",$J)
K DIC,DA,DR
K AG("ITEM"),AG("MBRREC"),AG("MBRSEL"),AG("REDFN")
S AG=0
;S AG("DFN")=AGELP("PH")
S AG("DFN")=POLHPTR ;IHS/SD/TPF AG*7.1*1
S AG("HOLD")=0
S AG("RECCNT")=1
F S AG=$O(AG("TMPMBR",AG)) Q:'AG!$D(DUOUT)!$D(DFOUT)!$D(AG("ONEMBR")) D
. S AG("REC")=$G(AG("TMPMBR",AG))
. S AG("RECCNT")=AG("RECCNT")+1
. Q:AG=0
. ;I AG=1 W !,"POLICY HOLDER : ",$P($G(^AUPN3PPH(AGELP("PH"),0)),U),!
. I AG=1 W !,"POLICY HOLDER : ",$P($G(^AUPN3PPH(POLHPTR,0)),U),! ;;IHS/SD/TPF AG*7.1*1
. S AG("DFN")=$P(AG("REC"),U)
. I AG("DFN")'=AG("HOLD")&(AG>5) D
.. W !!,"POLICY MEMBER : ",$P($G(^DPT(AG("DFN"),0)),U)
.. S AG("HRN")=$P($G(^AUPNPAT(AG("DFN"),41,DUZ(2),0)),U,2)
.. W " ( ",AG("HRN")," )",!
.. S AG("HOLD")=AG("DFN")
. W !,AG,". "
. S DIC=$P(AG("REC"),U,2)
. S DA=$P(AG("REC"),U,3)
. S DR=$P(AG("REC"),U,4)
. S AG("LBL")=$P(AG("REC"),U,5)
. D MBRLBL
. W ?29,$$GET1^DIQ(DIC,DA,DR)
. I AG("RECCNT")=12&($D(AG("ONEMBR"))) S DIR(0)="E" D ASK S AG="" Q
. I AG("RECCNT")=12 S AG("RECCNT")=0,DIR(0)="E" D ASK D Q
.. Q:$D(DUOUT)!$D(DFOUT)!($D(DTOUT)) ;AG*7.1*2 NOT EXITING POLICY MEMBER VIEW PAGE CORRECTLY
.. I $D(AGX) D
... I AGX>0&(AGX<(AG("FLDCNT"))) D
.... S AG("HOLD")=0
.... F X=1:1:AGX I X#6=0 S AG=X-1 K AGX Q
. I AG("RECCNT")'=12&(AG=AG("FLDCNT")) S DIR(0)="E" D ASK D Q
.. Q:$D(DUOUT)!$D(DFOUT)!$D(DTOUT) ;AG*7.1*2 NOT EXITING POLICY MEMBER VIEW PAGE CORRECTLY
.. I $D(AGX) D
... S AG("HOLD")=0
... F X=1:1:AGX I X#6=0 S AG=X-1 K AGX Q
K AG("RECCNT"),AG("ONEMBR")
K DIC,DA,DR,AGY,AGI,AGX,AG("LBL"),AG("DFN"),AG("HOLD"),AG("REC"),AG("HRN")
;AFTER EDITING THE SELECTION MUST BE UPDATED SO ANY ERRORS CORRECTED WILL BE REFLECTED ON THE REDRAWN SCREEN
S:$G(AGSELECT)'="" AGSELECT=$$FINDPVT^AGINSUPD(AGSELECT)
Q
ASK ;
K DIR,DLOUT,DUOUT,DFOUT,DQOUT,Y
S DIR("A")="CHANGE which item? (1-"_AG_") ""RETURN"" to continue // "
S DIR("A",1)="Enter ""^"" to return to the Eligibility screen "
;AG*7.1*2 TOOK OUT FUNCTION BELOW. YOU CANNOT EXIT OUT TO SUMMARY PAGE BEACUSE IT
;WOULD ALLOW BYPASSING ERRORS.
;S DIR("A",2)="Enter ""^^"" to return to the Insurance Summary screen "
D READ
Q:$D(DLOUT)!($D(DUOUT))!(Y["N")
Q:$D(DFOUT)!($D(DTOUT))
I $D(DQOUT)!(+Y<1)!(+Y>AG) W !!,"You must enter a number from 1 to ",AG H 2 Q
S AG("C")="HASTREET,HACITY,HASTATE,HAZIP,HPHONE,MEMNUM,REL,MEMDOB,FROM,THRU,PERCOD"
S AGY=Y
S AGX=Y
F AGI=1:1 S AG("SEL")=+$P(AGY,",",AGI) Q:AG("SEL")<1!(AG("SEL")>AG) D MBRSEL,@($P(AG("C"),",",AG("SEL"))) ; IHS/SD/EFG AG*7.1 4/16/2004
D UPDATE1^AGED(DUZ(2),DFN,3,"")
K AGI,AGY
Q
READ ;EP
K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,AG("ED"),AG("ERR"),DIROUT
S DIR(0)="FO"
D ^DIR
Q:$D(DTOUT)
S:Y="/.,"!(Y="^^") DFOUT=""
S:Y="" DLOUT=""
S:Y="^" (DUOUT,Y)=""
S:Y?1"?".E!(Y["^") (DQOUT,Y)=""
Q:Y="P"
I $E(Y,1)="p" S $E(Y,1)="P"
I $E(Y,1)="P"&($P($G(^AUPNPAT(DFN,11)),U,12)'="") D
. S AG("ED")=+$E(Y,2,99)
. I AG("ED")<1!(AG("ED")>9) D
.. W *7,!!,"Use only pages 1 through 9."
.. H 2
.. K AG("ED")
.. S AG("ERR")=""
. I $D(AG("ED")) D
.. I AG("ED")>0&(AG("ED")<10) D
... I AG("ED")=4 S AG("ED")="4A"
... I AG("ED")=5 S AG("ED")="BEA"
... I AG("ED")=6 S AG("ED")=13
... I AG("ED")=8 S AG("ED")=11
... I AG("ED")=7 S AG("ED")=8
... I AG("ED")=9 S AG("ED")="11A"
I $E(Y,1)="P"&($P($G(^AUPNPAT(DFN,11)),U,12)="") D
. W *7,!!,"Eligibility Status must be entered." H 2
Q
HASTREET ;POLICY HOLDER'S STREET
W !
K DIC,DR,DIE,DA,DIR
S DIE="^AUPN3PPH("
;S DA=AGELP("PH")
S DA=POLHPTR ;IHS/SD/TPF AG*7.1*1
S DR=.09
D ^DIE
K DIC,DR,DIE,DA,DIR
Q
HACITY ;POLICY HOLDER'S CITY
W !
K DIC,DR,DIE,DA,DIR
S DIE="^AUPN3PPH("
;S DA=AGELP("PH")
S DA=POLHPTR ;IHS/SD/TPF AG*7.1*1
S DR=.11
D ^DIE
K DIC,DR,DIE,DA,DIR
Q
HASTATE ;POLICY HOLDER'S STATE
W !
K DIC,DR,DIE,DA,DIR
S DIE="^AUPN3PPH("
;S DA=AGELP("PH")
S DA=POLHPTR ;IHS/SD/TPF AG*7.1*1
S DR=.12
D ^DIE
K DIC,DR,DIE,DA,DIR
Q
HAZIP ;POLICY HOLDER'S ZIP CODE
W !
K DIC,DR,DIE,DA,DIR
S DIE="^AUPN3PPH("
;S DA=AGELP("PH")
S DA=POLHPTR ;IHS/SD/TPF AG*7.1*1
S DR=.13
D ^DIE
K DIC,DR,DIE,DA,DIR
Q
HPHONE ;POLICY HOLDER'S PHONE #
W !
K DIC,DR,DIE,DA,DIR
S DIE="^AUPN3PPH("
;S DA=AGELP("PH")
S DA=POLHPTR ;IHS/SD/TPF AG*7.1*1
S DR=.14
D ^DIE
K DIC,DR,DIE,DA,DIR
Q
MBRSEL ;DETERMINE WHICH FIELD TO EDIT
S AG("MBRREC")=$G(AG("TMPMBR",AG("SEL")))
S AG("ITEM")=$P(AG("MBRREC"),U,5)
S AG("SEL")=AG("ITEM")
S AG("REDFN")=$P(AG("MBRREC"),U)
Q
FINDPH ;GATHER FIELDS FOR POLICY HOLDER
;S AG("PHREC")=$G(^AUPN3PPH(AGELP("PH"),0))
;S AG("TMPMBR",0)=""
;S AG("TMPMBR",1)=AGELP("PH")_"^"_9000003.1_"^"_AGELP("PH")_"^"_.09_"^"_1
;S AG("TMPMBR",2)=AGELP("PH")_"^"_9000003.1_"^"_AGELP("PH")_"^"_.11_"^"_2
;S AG("TMPMBR",3)=AGELP("PH")_"^"_9000003.1_"^"_AGELP("PH")_"^"_.12_"^"_3
;S AG("TMPMBR",4)=AGELP("PH")_"^"_9000003.1_"^"_AGELP("PH")_"^"_.13_"^"_4
;S AG("TMPMBR",5)=AGELP("PH")_"^"_9000003.1_"^"_AGELP("PH")_"^"_.14_"^"_5
;IHS/SD/TPF AG*7.1*1 USE OF AGELP("PH") REPLACE IN ALL LINES ABOVE
S AG("PHREC")=$G(^AUPN3PPH(POLHPTR,0))
S AG("TMPMBR",0)=""
S AG("TMPMBR",1)=POLHPTR_"^"_9000003.1_"^"_POLHPTR_"^"_.09_"^"_1
S AG("TMPMBR",2)=POLHPTR_"^"_9000003.1_"^"_POLHPTR_"^"_.11_"^"_2
S AG("TMPMBR",3)=POLHPTR_"^"_9000003.1_"^"_POLHPTR_"^"_.12_"^"_3
S AG("TMPMBR",4)=POLHPTR_"^"_9000003.1_"^"_POLHPTR_"^"_.13_"^"_4
S AG("TMPMBR",5)=POLHPTR_"^"_9000003.1_"^"_POLHPTR_"^"_.14_"^"_5
Q
ALLMBR ;GATHER FIELDS FOR ALL MEMBERS
S AG("MBR")=0
S AG("FLDCNT")=5
;F S AG("MBR")=$O(^AUPNPRVT("C",AGELP("PH"),AG("MBR"))) Q:'AG("MBR") D
F S AG("MBR")=$O(^AUPNPRVT("C",POLHPTR,AG("MBR"))) Q:'AG("MBR") D ;IHS/SD/TPF AG*7.1*1
. S AG("PREC")=0
. ;F S AG("PREC")=$O(^AUPNPRVT("C",AGELP("PH"),AG("MBR"),AG("PREC"))) Q:'AG("PREC") D
. F S AG("PREC")=$O(^AUPNPRVT("C",POLHPTR,AG("MBR"),AG("PREC"))) Q:'AG("PREC") D ;IHS/SD/TPF AG*7.1*1
.. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_21_"^"_6
.. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.05_"^"_7
.. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_2_"^"_AG("MBR")_"^"_.03_"^"_8
.. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.06_"^"_9
.. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.07_"^"_10
.. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.12_"^"_11
K AG("MBR"),AG("PREC")
Q
ONEMBR ;GATHER FIELDS FOR ONE MEMBER
S AG("ONEMBR")=""
S AG("MBRSEL")=$E(Y,2,4)
S AG("MBRPTR")=0
F S AG("MBRPTR")=$O(AGELP(AG("MBRPTR"))) Q:'AG("MBRPTR") D
. I $P($G(AGELP(AG("MBRPTR"))),U)=AG("MBRSEL") S AG("MBR")=AG("MBRPTR")
S AG("FLDCNT")=5
S AG("PREC")=0
;F S AG("PREC")=$O(^AUPNPRVT("C",AGELP("PH"),AG("MBR"),AG("PREC"))) Q:'AG("PREC") D
F S AG("PREC")=$O(^AUPNPRVT("C",POLHPTR,AG("MBR"),AG("PREC"))) Q:'AG("PREC") D ;IHS/SD/TPF AG*7.1*1
. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_21_"^"_6
. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.05_"^"_7
. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_2_"^"_AG("MBR")_"^"_.03_"^"_8
. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.06_"^"_9
. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.07_"^"_10
. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.12_"^"_11
K AG("MBR"),AG("PREC")
Q
MBRLBL ;FIND CORRECT FIELD LABEL FOR MEMBER LINE
I AG("LBL")=1 W ?5,"HOLDER'S ADDRRESS-STREET...: " Q
I AG("LBL")=2 W ?5,"HOLDER'S ADDRRESS-CITY.....: " Q
I AG("LBL")=3 W ?5,"HOLDER'S ADDRRESS-STATE....: " Q
I AG("LBL")=4 W ?5,"HOLDER'S ADDRRESS-ZIP......: " Q
I AG("LBL")=5 W ?5,"HOLDER'S TELEPHONE NUMBER..: " Q
I AG("LBL")=6 W ?5,"MEMBER NUMBER.............: " Q
I AG("LBL")=7 W ?5,"RELATIONSHIP TO INSURED...: " Q
I AG("LBL")=8 W ?5,"POLICY MEMBER DOB.........: " Q
I AG("LBL")=9 W ?5,"FROM......................: " Q
I AG("LBL")=10 W ?5,"THRU......................: " Q
I AG("LBL")=11 W ?5,"PERSON CODE...............: " Q
Q
MEMNUM ;MEMBER #
W !
K DIC,DR,DIE,DA,DD,DO
S DA(1)=$P(AG("MBRREC"),U)
S DIE="^AUPNPRVT("_DA(1)_",11,"
S DA=$P($P(AG("MBRREC"),U,3),",")
S DR=21
D ^DIE
K DIC,DR,DIE,DA
Q
REL ;MEMBER RELATIONSHIP TO INSURED
W !
K DIC,DR,DIE,DA,DD,DO
S DA(1)=$P(AG("MBRREC"),U)
S DIE="^AUPNPRVT("_DA(1)_",11,"
S DA=$P($P(AG("MBRREC"),U,3),",")
;S DR=.05
S DR=".05R" ;IHS/SD/TPF AG*7.1*1
D ^DIE
K DIC,DR,DIE,DA
;IHS/SD/TPF AG*7.1*1 ADDED LINE BELOW
I $D(POLMEMBS("SELF")),($P($G(^AUPNPRVT($P(AG("MBRREC"),U),11,$P($P(AG("MBRREC"),U,3),","),0)),U,5)=25) Q:(POLMEMBS("SELF")=$P(AG("MBRREC"),U)) D G REL
.W !!,"THERE IS ALREADY A POLICY HOLDER FOR THIS POLICY!!"
.S $P(^AUPNPRVT($P(AG("MBRREC"),U),11,$P($P(AG("MBRREC"),U,3),","),0),U,5)=""
Q
MEMDOB ;MEMBER DOB
W !
K DIC,DR,DIE,DA,DD,DO
S DIE="^DPT("
S DA=$P(AG("MBRREC"),U)
S DR=.03
D ^DIE
K DIC,DR,DIE,DA
Q
FROM ;MEMBER ELIGIBILITY DATE
FROM1 ;EP
W !
N PRVTIEN
K DIC,DR,DIE,DA,DD,DO
S DA(1)=$P(AG("MBRREC"),U)
S DIE="^AUPNPRVT("_DA(1)_",11,"
S DA=$P($P(AG("MBRREC"),U,3),",")
;S DR=.06
S DR=".06R" ;AG*7.1*2 ISSUE REPORTED DURING ALPHA TESTING
D ^DIE
;AG*7.1*2 FOUND IN TESTING.
;QUICK FIX FOR PATCH 2
;CHANGE WILL BE MADE TO DD FOR AUPNPRVT
K GOFROM1
I $$GET1^DIQ(9000006.11,$P($P(AG("MBRREC"),U,3),",")_","_$P(AG("MBRREC"),U)_",",.07,"I") D G:$G(GOFROM1) FROM1
.I ($$GET1^DIQ(9000006.11,$P($P(AG("MBRREC"),U,3),",")_","_$P(AG("MBRREC"),U)_",",.06,"I")>$$GET1^DIQ(9000006.11,$P($P(AG("MBRREC"),U,3),",")_","_$P(AG("MBRREC"),U)_",",.07,"I")) D
..S GOFROM1=1
..W !!,"STARTING DATE CANNOT BE AFTER TERMINATION DATE!" H 2
K DIC,DR,DIE,DA
I $G(POLMEMBS("SELF"))=AGPATDFN D Q
.K DR,DIE,DIC,DA,DIR
.S PRVTIEN=$P(AG("MBRREC"),U,3)_","
.S DR=".17///^S X=$$GET1^DIQ(9000006.11,PRVTIEN,.06,""E"")"
.S DIE="^AUPN3PPH("
.S DA=POLHPTR
.D ^DIE
.K DR,DIE,DIC,DA,DIR
Q
THRU ;MEMBER ELIGIBILITY END DATE
W !
;AG*7.1*2 ERROR FOUND DURING ALPHA TESTING
N AGNEWDT,AGOLDDT,PRVTIEN
S PRVTIEN=$P(AG("MBRREC"),U,3)_","
;AG*7.1*2 ISSUE REPORTED DURING ALPHA TESTING
I '$$GET1^DIQ(9000006.11,PRVTIEN,.06,"I") D Q
.W !!,"YOU MUST ENTER A BEGIN DATE BEFORE ENTERING AN ENDING DATE!!"
.K DIR
.S DIR(0)="E"
.D ^DIR
S AGOLDDT=$$GET1^DIQ(9000006.11,PRVTIEN,.07,"I")
K DIC,DR,DIE,DA,DD,DO
S DA(1)=$P(AG("MBRREC"),U)
S DIE="^AUPNPRVT("_DA(1)_",11,"
S DA=$P($P(AG("MBRREC"),U,3),",")
S DR=.07
D ^DIE
S AGNEWDT=$$GET1^DIQ(9000006.11,PRVTIEN,.07,"I")
K DIC,DR,DIE,DA
Q:AGOLDDT=AGNEWDT
Q:$G(POLMEMBS("SELF"))="" ;IF NO SELF THEN POLICY HOLDER IS NOT LISTED IN THE MEMBER SECTION I.E. NOT REG.
I $P($G(POLMEMBS("SELF")),U)=$P(AG("MBRREC"),U) D Q
.K DR,DIE,DIC,DA,DIR
.I AGNEWDT="" S DR=".18///@"
.E S DR=".18///^S X=$$GET1^DIQ(9000006.11,PRVTIEN,.07,""E"")"
.S DIE="^AUPN3PPH("
.S DA=POLHPTR
.D ^DIE
.K DR,DIE,DIC,DA,DIR
.D UPDTERM^AGEDPRVP(AGELP("PH"),AGNEWDT,AGOLDDT)
Q
PERCOD ;MEMBER PERSON CODE
W !
K DIC,DR,DIE,DA,DD,DO
S DA(1)=$P(AG("MBRREC"),U)
S DIE="^AUPNPRVT("_DA(1)_",11,"
S DA=$P($P(AG("MBRREC"),U,3),",")
S DR=.12
D ^DIE
K DIC,DR,DIE,DA
Q
AGPHADDR ; IHS/ASDS/EFG - DISPLAY/EDIT POLICY HOLDER ADDR/MEMBERS ;
+1 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
+2 ;
+3 ;IHS/SD/TPF 9/15/2005 AG*7.1*1
+4 ;MODIFIED TO GET RID OF USE OF AGELP("PH")
+5 ;AND USE A PARAMETER INSTEAD
+6 ;
+7 ;ADDED EN CALL IHS/SD/TPF 9/15/2005 AG*7.1*1
QUIT
EN(POLHPTR) ;EP - DISPLAY/EDIT POLICY HOLDER ADDR/MEMBERS IHS/SD/TPF 9/15/2005 AG*7.1*1
+1 ;AG*7.1*1
IF 'POLHPTR
WRITE !,"POLICY HOLDER UNDEFINED FOR THIS ENTRY!"
HANG 3
QUIT
+2 KILL AG("FLDCNT")
+3 IF $DATA(AG("TMPMBR"))
KILL AG("TMPMBR")
+4 ;LOAD AG("TMPMBR") WITH POLICY HOLDER FIELDS
DO FINDPH
+5 ;DISPLAY FIELDS FOR ALL MEMBERS
IF Y="V"
DO ALLMBR
+6 ;DISPLAY FIELDS FOR SELECTED MEMBER
IF $LENGTH(Y)>1
DO ONEMBR
VAR ;
+1 DO ^XBCLS
+2 DO HDR
+3 DO DRAW
+4 IF $DATA(AGSEENLY)
QUIT
+5 IF $DATA(DLOUT)!($DATA(DUOUT))
GOTO END
+6 IF $DATA(DFOUT)!$DATA(DTOUT)
QUIT
+7 GOTO VAR
END ;K AG("PH9"),AG("PH11"),AG("PH12"),AG("PH13"),AG("PH14"),DTOUT,DUOUT,DLOUT,DFOUT,DQOUT
+1 ;DON'T KILL DFOUT - ^^ AND "/.," WON'T WORK
KILL AG("PH9"),AG("PH11"),AG("PH12"),AG("PH13"),AG("PH14"),DTOUT,DUOUT,DLOUT,DQOUT
+2 IF $DATA(AGXTERN)
QUIT
+3 IF $DATA(DIROUT)
QUIT
+4 IF $DATA(AGSEENLY)
QUIT
+5 QUIT
HDR ;
+1 IF '$DATA(IOF)
DO HOME^%ZIS
+2 WRITE $$S^AGVDF("IOF"),!
+3 WRITE "IHS REGISTRATION ",$SELECT($DATA(AGSEENLY):"VIEW SCREEN",1:"EDITOR")
+4 WRITE ?31,"Policy Holder View"
+5 WRITE ?78-$LENGTH($PIECE($GET(^DIC(4,DUZ(2),0)),U)),$PIECE($GET(^DIC(4,DUZ(2),0)),U)
+6 SET AGLINE("-")=$TRANSLATE($JUSTIFY(" ",78)," ","-")
+7 SET AGLINE("EQ")=$TRANSLATE($JUSTIFY(" ",78)," ","=")
+8 WRITE !,AGLINE("EQ")
+9 IF '$DATA(AGPAT)
SET AGPAT=$PIECE($GET(^DPT(DFN,0)),U)
+10 WRITE !,$EXTRACT(AGPAT,1,23)
+11 WRITE ?36,$$DTEST^AGUTILS(DFN)
+12 IF $DATA(AGCHRT)
WRITE ?55,"HRN:",AGCHRT
+13 IF AG("PG")>1
Begin DoDot:1
+14 ;GET ELIGIBILITY STATUS
+15 SET AGELSTS=$PIECE($GET(^AUPNPAT(DFN,11)),U,12)
+16 WRITE ?66,$SELECT(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PEND. VERIF",1:"NONE"),!
End DoDot:1
+17 WRITE AGLINE("EQ"),!
+18 QUIT
DRAW ;EP
+1 NEW DA
+2 ;S DA=AGELP("PH")
+3 ;IHS/SD/TPF AG*7.1*1
SET DA=POLHPTR
+4 KILL ^UTILITY("DIQ1",$JOB)
+5 KILL DIC,DA,DR
+6 KILL AG("ITEM"),AG("MBRREC"),AG("MBRSEL"),AG("REDFN")
+7 SET AG=0
+8 ;S AG("DFN")=AGELP("PH")
+9 ;IHS/SD/TPF AG*7.1*1
SET AG("DFN")=POLHPTR
+10 SET AG("HOLD")=0
+11 SET AG("RECCNT")=1
+12 FOR
SET AG=$ORDER(AG("TMPMBR",AG))
IF 'AG!$DATA(DUOUT)!$DATA(DFOUT)!$DATA(AG("ONEMBR"))
QUIT
Begin DoDot:1
+13 SET AG("REC")=$GET(AG("TMPMBR",AG))
+14 SET AG("RECCNT")=AG("RECCNT")+1
+15 IF AG=0
QUIT
+16 ;I AG=1 W !,"POLICY HOLDER : ",$P($G(^AUPN3PPH(AGELP("PH"),0)),U),!
+17 ;;IHS/SD/TPF AG*7.1*1
IF AG=1
WRITE !,"POLICY HOLDER : ",$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U),!
+18 SET AG("DFN")=$PIECE(AG("REC"),U)
+19 IF AG("DFN")'=AG("HOLD")&(AG>5)
Begin DoDot:2
+20 WRITE !!,"POLICY MEMBER : ",$PIECE($GET(^DPT(AG("DFN"),0)),U)
+21 SET AG("HRN")=$PIECE($GET(^AUPNPAT(AG("DFN"),41,DUZ(2),0)),U,2)
+22 WRITE " ( ",AG("HRN")," )",!
+23 SET AG("HOLD")=AG("DFN")
End DoDot:2
+24 WRITE !,AG,". "
+25 SET DIC=$PIECE(AG("REC"),U,2)
+26 SET DA=$PIECE(AG("REC"),U,3)
+27 SET DR=$PIECE(AG("REC"),U,4)
+28 SET AG("LBL")=$PIECE(AG("REC"),U,5)
+29 DO MBRLBL
+30 WRITE ?29,$$GET1^DIQ(DIC,DA,DR)
+31 IF AG("RECCNT")=12&($DATA(AG("ONEMBR")))
SET DIR(0)="E"
DO ASK
SET AG=""
QUIT
+32 IF AG("RECCNT")=12
SET AG("RECCNT")=0
SET DIR(0)="E"
DO ASK
Begin DoDot:2
+33 ;AG*7.1*2 NOT EXITING POLICY MEMBER VIEW PAGE CORRECTLY
IF $DATA(DUOUT)!$DATA(DFOUT)!($DATA(DTOUT))
QUIT
+34 IF $DATA(AGX)
Begin DoDot:3
+35 IF AGX>0&(AGX<(AG("FLDCNT")))
Begin DoDot:4
+36 SET AG("HOLD")=0
+37 FOR X=1:1:AGX
IF X#6=0
SET AG=X-1
KILL AGX
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+38 IF AG("RECCNT")'=12&(AG=AG("FLDCNT"))
SET DIR(0)="E"
DO ASK
Begin DoDot:2
+39 ;AG*7.1*2 NOT EXITING POLICY MEMBER VIEW PAGE CORRECTLY
IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)
QUIT
+40 IF $DATA(AGX)
Begin DoDot:3
+41 SET AG("HOLD")=0
+42 FOR X=1:1:AGX
IF X#6=0
SET AG=X-1
KILL AGX
QUIT
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+43 KILL AG("RECCNT"),AG("ONEMBR")
+44 KILL DIC,DA,DR,AGY,AGI,AGX,AG("LBL"),AG("DFN"),AG("HOLD"),AG("REC"),AG("HRN")
+45 ;AFTER EDITING THE SELECTION MUST BE UPDATED SO ANY ERRORS CORRECTED WILL BE REFLECTED ON THE REDRAWN SCREEN
+46 IF $GET(AGSELECT)'=""
SET AGSELECT=$$FINDPVT^AGINSUPD(AGSELECT)
+47 QUIT
ASK ;
+1 KILL DIR,DLOUT,DUOUT,DFOUT,DQOUT,Y
+2 SET DIR("A")="CHANGE which item? (1-"_AG_") ""RETURN"" to continue // "
+3 SET DIR("A",1)="Enter ""^"" to return to the Eligibility screen "
+4 ;AG*7.1*2 TOOK OUT FUNCTION BELOW. YOU CANNOT EXIT OUT TO SUMMARY PAGE BEACUSE IT
+5 ;WOULD ALLOW BYPASSING ERRORS.
+6 ;S DIR("A",2)="Enter ""^^"" to return to the Insurance Summary screen "
+7 DO READ
+8 IF $DATA(DLOUT)!($DATA(DUOUT))!(Y["N")
QUIT
+9 IF $DATA(DFOUT)!($DATA(DTOUT))
QUIT
+10 IF $DATA(DQOUT)!(+Y<1)!(+Y>AG)
WRITE !!,"You must enter a number from 1 to ",AG
HANG 2
QUIT
+11 SET AG("C")="HASTREET,HACITY,HASTATE,HAZIP,HPHONE,MEMNUM,REL,MEMDOB,FROM,THRU,PERCOD"
+12 SET AGY=Y
+13 SET AGX=Y
+14 ; IHS/SD/EFG AG*7.1 4/16/2004
FOR AGI=1:1
SET AG("SEL")=+$PIECE(AGY,",",AGI)
IF AG("SEL")<1!(AG("SEL")>AG)
QUIT
DO MBRSEL
DO @($PIECE(AG("C"),",",AG("SEL")))
+15 DO UPDATE1^AGED(DUZ(2),DFN,3,"")
+16 KILL AGI,AGY
+17 QUIT
READ ;EP
+1 KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,AG("ED"),AG("ERR"),DIROUT
+2 SET DIR(0)="FO"
+3 DO ^DIR
+4 IF $DATA(DTOUT)
QUIT
+5 IF Y="/.,"!(Y="^^")
SET DFOUT=""
+6 IF Y=""
SET DLOUT=""
+7 IF Y="^"
SET (DUOUT,Y)=""
+8 IF Y?1"?".E!(Y["^")
SET (DQOUT,Y)=""
+9 IF Y="P"
QUIT
+10 IF $EXTRACT(Y,1)="p"
SET $EXTRACT(Y,1)="P"
+11 IF $EXTRACT(Y,1)="P"&($PIECE($GET(^AUPNPAT(DFN,11)),U,12)'="")
Begin DoDot:1
+12 SET AG("ED")=+$EXTRACT(Y,2,99)
+13 IF AG("ED")<1!(AG("ED")>9)
Begin DoDot:2
+14 WRITE *7,!!,"Use only pages 1 through 9."
+15 HANG 2
+16 KILL AG("ED")
+17 SET AG("ERR")=""
End DoDot:2
+18 IF $DATA(AG("ED"))
Begin DoDot:2
+19 IF AG("ED")>0&(AG("ED")<10)
Begin DoDot:3
+20 IF AG("ED")=4
SET AG("ED")="4A"
+21 IF AG("ED")=5
SET AG("ED")="BEA"
+22 IF AG("ED")=6
SET AG("ED")=13
+23 IF AG("ED")=8
SET AG("ED")=11
+24 IF AG("ED")=7
SET AG("ED")=8
+25 IF AG("ED")=9
SET AG("ED")="11A"
End DoDot:3
End DoDot:2
End DoDot:1
+26 IF $EXTRACT(Y,1)="P"&($PIECE($GET(^AUPNPAT(DFN,11)),U,12)="")
Begin DoDot:1
+27 WRITE *7,!!,"Eligibility Status must be entered."
HANG 2
End DoDot:1
+28 QUIT
HASTREET ;POLICY HOLDER'S STREET
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DIR
+3 SET DIE="^AUPN3PPH("
+4 ;S DA=AGELP("PH")
+5 ;IHS/SD/TPF AG*7.1*1
SET DA=POLHPTR
+6 SET DR=.09
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA,DIR
+9 QUIT
HACITY ;POLICY HOLDER'S CITY
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DIR
+3 SET DIE="^AUPN3PPH("
+4 ;S DA=AGELP("PH")
+5 ;IHS/SD/TPF AG*7.1*1
SET DA=POLHPTR
+6 SET DR=.11
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA,DIR
+9 QUIT
HASTATE ;POLICY HOLDER'S STATE
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DIR
+3 SET DIE="^AUPN3PPH("
+4 ;S DA=AGELP("PH")
+5 ;IHS/SD/TPF AG*7.1*1
SET DA=POLHPTR
+6 SET DR=.12
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA,DIR
+9 QUIT
HAZIP ;POLICY HOLDER'S ZIP CODE
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DIR
+3 SET DIE="^AUPN3PPH("
+4 ;S DA=AGELP("PH")
+5 ;IHS/SD/TPF AG*7.1*1
SET DA=POLHPTR
+6 SET DR=.13
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA,DIR
+9 QUIT
HPHONE ;POLICY HOLDER'S PHONE #
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DIR
+3 SET DIE="^AUPN3PPH("
+4 ;S DA=AGELP("PH")
+5 ;IHS/SD/TPF AG*7.1*1
SET DA=POLHPTR
+6 SET DR=.14
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA,DIR
+9 QUIT
MBRSEL ;DETERMINE WHICH FIELD TO EDIT
+1 SET AG("MBRREC")=$GET(AG("TMPMBR",AG("SEL")))
+2 SET AG("ITEM")=$PIECE(AG("MBRREC"),U,5)
+3 SET AG("SEL")=AG("ITEM")
+4 SET AG("REDFN")=$PIECE(AG("MBRREC"),U)
+5 QUIT
FINDPH ;GATHER FIELDS FOR POLICY HOLDER
+1 ;S AG("PHREC")=$G(^AUPN3PPH(AGELP("PH"),0))
+2 ;S AG("TMPMBR",0)=""
+3 ;S AG("TMPMBR",1)=AGELP("PH")_"^"_9000003.1_"^"_AGELP("PH")_"^"_.09_"^"_1
+4 ;S AG("TMPMBR",2)=AGELP("PH")_"^"_9000003.1_"^"_AGELP("PH")_"^"_.11_"^"_2
+5 ;S AG("TMPMBR",3)=AGELP("PH")_"^"_9000003.1_"^"_AGELP("PH")_"^"_.12_"^"_3
+6 ;S AG("TMPMBR",4)=AGELP("PH")_"^"_9000003.1_"^"_AGELP("PH")_"^"_.13_"^"_4
+7 ;S AG("TMPMBR",5)=AGELP("PH")_"^"_9000003.1_"^"_AGELP("PH")_"^"_.14_"^"_5
+8 ;IHS/SD/TPF AG*7.1*1 USE OF AGELP("PH") REPLACE IN ALL LINES ABOVE
+9 SET AG("PHREC")=$GET(^AUPN3PPH(POLHPTR,0))
+10 SET AG("TMPMBR",0)=""
+11 SET AG("TMPMBR",1)=POLHPTR_"^"_9000003.1_"^"_POLHPTR_"^"_.09_"^"_1
+12 SET AG("TMPMBR",2)=POLHPTR_"^"_9000003.1_"^"_POLHPTR_"^"_.11_"^"_2
+13 SET AG("TMPMBR",3)=POLHPTR_"^"_9000003.1_"^"_POLHPTR_"^"_.12_"^"_3
+14 SET AG("TMPMBR",4)=POLHPTR_"^"_9000003.1_"^"_POLHPTR_"^"_.13_"^"_4
+15 SET AG("TMPMBR",5)=POLHPTR_"^"_9000003.1_"^"_POLHPTR_"^"_.14_"^"_5
+16 QUIT
ALLMBR ;GATHER FIELDS FOR ALL MEMBERS
+1 SET AG("MBR")=0
+2 SET AG("FLDCNT")=5
+3 ;F S AG("MBR")=$O(^AUPNPRVT("C",AGELP("PH"),AG("MBR"))) Q:'AG("MBR") D
+4 ;IHS/SD/TPF AG*7.1*1
FOR
SET AG("MBR")=$ORDER(^AUPNPRVT("C",POLHPTR,AG("MBR")))
IF 'AG("MBR")
QUIT
Begin DoDot:1
+5 SET AG("PREC")=0
+6 ;F S AG("PREC")=$O(^AUPNPRVT("C",AGELP("PH"),AG("MBR"),AG("PREC"))) Q:'AG("PREC") D
+7 ;IHS/SD/TPF AG*7.1*1
FOR
SET AG("PREC")=$ORDER(^AUPNPRVT("C",POLHPTR,AG("MBR"),AG("PREC")))
IF 'AG("PREC")
QUIT
Begin DoDot:2
+8 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_21_"^"_6
+9 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.05_"^"_7
+10 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_2_"^"_AG("MBR")_"^"_.03_"^"_8
+11 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.06_"^"_9
+12 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.07_"^"_10
+13 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.12_"^"_11
End DoDot:2
End DoDot:1
+14 KILL AG("MBR"),AG("PREC")
+15 QUIT
ONEMBR ;GATHER FIELDS FOR ONE MEMBER
+1 SET AG("ONEMBR")=""
+2 SET AG("MBRSEL")=$EXTRACT(Y,2,4)
+3 SET AG("MBRPTR")=0
+4 FOR
SET AG("MBRPTR")=$ORDER(AGELP(AG("MBRPTR")))
IF 'AG("MBRPTR")
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(AGELP(AG("MBRPTR"))),U)=AG("MBRSEL")
SET AG("MBR")=AG("MBRPTR")
End DoDot:1
+6 SET AG("FLDCNT")=5
+7 SET AG("PREC")=0
+8 ;F S AG("PREC")=$O(^AUPNPRVT("C",AGELP("PH"),AG("MBR"),AG("PREC"))) Q:'AG("PREC") D
+9 ;IHS/SD/TPF AG*7.1*1
FOR
SET AG("PREC")=$ORDER(^AUPNPRVT("C",POLHPTR,AG("MBR"),AG("PREC")))
IF 'AG("PREC")
QUIT
Begin DoDot:1
+10 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_21_"^"_6
+11 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.05_"^"_7
+12 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_2_"^"_AG("MBR")_"^"_.03_"^"_8
+13 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.06_"^"_9
+14 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.07_"^"_10
+15 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPMBR",AG("FLDCNT"))=AG("MBR")_"^"_9000006.11_"^"_AG("PREC")_","_AG("MBR")_"^"_.12_"^"_11
End DoDot:1
+16 KILL AG("MBR"),AG("PREC")
+17 QUIT
MBRLBL ;FIND CORRECT FIELD LABEL FOR MEMBER LINE
+1 IF AG("LBL")=1
WRITE ?5,"HOLDER'S ADDRRESS-STREET...: "
QUIT
+2 IF AG("LBL")=2
WRITE ?5,"HOLDER'S ADDRRESS-CITY.....: "
QUIT
+3 IF AG("LBL")=3
WRITE ?5,"HOLDER'S ADDRRESS-STATE....: "
QUIT
+4 IF AG("LBL")=4
WRITE ?5,"HOLDER'S ADDRRESS-ZIP......: "
QUIT
+5 IF AG("LBL")=5
WRITE ?5,"HOLDER'S TELEPHONE NUMBER..: "
QUIT
+6 IF AG("LBL")=6
WRITE ?5,"MEMBER NUMBER.............: "
QUIT
+7 IF AG("LBL")=7
WRITE ?5,"RELATIONSHIP TO INSURED...: "
QUIT
+8 IF AG("LBL")=8
WRITE ?5,"POLICY MEMBER DOB.........: "
QUIT
+9 IF AG("LBL")=9
WRITE ?5,"FROM......................: "
QUIT
+10 IF AG("LBL")=10
WRITE ?5,"THRU......................: "
QUIT
+11 IF AG("LBL")=11
WRITE ?5,"PERSON CODE...............: "
QUIT
+12 QUIT
MEMNUM ;MEMBER #
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA(1)=$PIECE(AG("MBRREC"),U)
+4 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+5 SET DA=$PIECE($PIECE(AG("MBRREC"),U,3),",")
+6 SET DR=21
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 QUIT
REL ;MEMBER RELATIONSHIP TO INSURED
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA(1)=$PIECE(AG("MBRREC"),U)
+4 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+5 SET DA=$PIECE($PIECE(AG("MBRREC"),U,3),",")
+6 ;S DR=.05
+7 ;IHS/SD/TPF AG*7.1*1
SET DR=".05R"
+8 DO ^DIE
+9 KILL DIC,DR,DIE,DA
+10 ;IHS/SD/TPF AG*7.1*1 ADDED LINE BELOW
+11 IF $DATA(POLMEMBS("SELF"))
IF ($PIECE($GET(^AUPNPRVT($PIECE(AG("MBRREC"),U),11,$PIECE($PIECE(AG("MBRREC"),U,3),","),0)),U,5)=25)
IF (POLMEMBS("SELF")=$PIECE(AG("MBRREC"),U))
QUIT
Begin DoDot:1
+12 WRITE !!,"THERE IS ALREADY A POLICY HOLDER FOR THIS POLICY!!"
+13 SET $PIECE(^AUPNPRVT($PIECE(AG("MBRREC"),U),11,$PIECE($PIECE(AG("MBRREC"),U,3),","),0),U,5)=""
End DoDot:1
GOTO REL
+14 QUIT
MEMDOB ;MEMBER DOB
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DIE="^DPT("
+4 SET DA=$PIECE(AG("MBRREC"),U)
+5 SET DR=.03
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
FROM ;MEMBER ELIGIBILITY DATE
FROM1 ;EP
+1 WRITE !
+2 NEW PRVTIEN
+3 KILL DIC,DR,DIE,DA,DD,DO
+4 SET DA(1)=$PIECE(AG("MBRREC"),U)
+5 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+6 SET DA=$PIECE($PIECE(AG("MBRREC"),U,3),",")
+7 ;S DR=.06
+8 ;AG*7.1*2 ISSUE REPORTED DURING ALPHA TESTING
SET DR=".06R"
+9 DO ^DIE
+10 ;AG*7.1*2 FOUND IN TESTING.
+11 ;QUICK FIX FOR PATCH 2
+12 ;CHANGE WILL BE MADE TO DD FOR AUPNPRVT
+13 KILL GOFROM1
+14 IF $$GET1^DIQ(9000006.11,$PIECE($PIECE(AG("MBRREC"),U,3),",")_","_$PIECE(AG("MBRREC"),U)_",",.07,"I")
Begin DoDot:1
+15 IF ($$GET1^DIQ(9000006.11,$PIECE($PIECE(AG("MBRREC"),U,3),",")_","_$PIECE(AG("MBRREC"),U)_",",.06,"I")>$$GET1^DIQ(9000006.11,$PIECE($PIECE(AG("MBRREC"),U,3),",")_","_$PIECE(AG("MBRREC"),U)_",",.07,"I"))
Begin DoDot:2
+16 SET GOFROM1=1
+17 WRITE !!,"STARTING DATE CANNOT BE AFTER TERMINATION DATE!"
HANG 2
End DoDot:2
End DoDot:1
IF $GET(GOFROM1)
GOTO FROM1
+18 KILL DIC,DR,DIE,DA
+19 IF $GET(POLMEMBS("SELF"))=AGPATDFN
Begin DoDot:1
+20 KILL DR,DIE,DIC,DA,DIR
+21 SET PRVTIEN=$PIECE(AG("MBRREC"),U,3)_","
+22 SET DR=".17///^S X=$$GET1^DIQ(9000006.11,PRVTIEN,.06,""E"")"
+23 SET DIE="^AUPN3PPH("
+24 SET DA=POLHPTR
+25 DO ^DIE
+26 KILL DR,DIE,DIC,DA,DIR
End DoDot:1
QUIT
+27 QUIT
THRU ;MEMBER ELIGIBILITY END DATE
+1 WRITE !
+2 ;AG*7.1*2 ERROR FOUND DURING ALPHA TESTING
+3 NEW AGNEWDT,AGOLDDT,PRVTIEN
+4 SET PRVTIEN=$PIECE(AG("MBRREC"),U,3)_","
+5 ;AG*7.1*2 ISSUE REPORTED DURING ALPHA TESTING
+6 IF '$$GET1^DIQ(9000006.11,PRVTIEN,.06,"I")
Begin DoDot:1
+7 WRITE !!,"YOU MUST ENTER A BEGIN DATE BEFORE ENTERING AN ENDING DATE!!"
+8 KILL DIR
+9 SET DIR(0)="E"
+10 DO ^DIR
End DoDot:1
QUIT
+11 SET AGOLDDT=$$GET1^DIQ(9000006.11,PRVTIEN,.07,"I")
+12 KILL DIC,DR,DIE,DA,DD,DO
+13 SET DA(1)=$PIECE(AG("MBRREC"),U)
+14 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+15 SET DA=$PIECE($PIECE(AG("MBRREC"),U,3),",")
+16 SET DR=.07
+17 DO ^DIE
+18 SET AGNEWDT=$$GET1^DIQ(9000006.11,PRVTIEN,.07,"I")
+19 KILL DIC,DR,DIE,DA
+20 IF AGOLDDT=AGNEWDT
QUIT
+21 ;IF NO SELF THEN POLICY HOLDER IS NOT LISTED IN THE MEMBER SECTION I.E. NOT REG.
IF $GET(POLMEMBS("SELF"))=""
QUIT
+22 IF $PIECE($GET(POLMEMBS("SELF")),U)=$PIECE(AG("MBRREC"),U)
Begin DoDot:1
+23 KILL DR,DIE,DIC,DA,DIR
+24 IF AGNEWDT=""
SET DR=".18///@"
+25 IF '$TEST
SET DR=".18///^S X=$$GET1^DIQ(9000006.11,PRVTIEN,.07,""E"")"
+26 SET DIE="^AUPN3PPH("
+27 SET DA=POLHPTR
+28 DO ^DIE
+29 KILL DR,DIE,DIC,DA,DIR
+30 DO UPDTERM^AGEDPRVP(AGELP("PH"),AGNEWDT,AGOLDDT)
End DoDot:1
QUIT
+31 QUIT
PERCOD ;MEMBER PERSON CODE
+1 WRITE !
+2 KILL DIC,DR,DIE,DA,DD,DO
+3 SET DA(1)=$PIECE(AG("MBRREC"),U)
+4 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+5 SET DA=$PIECE($PIECE(AG("MBRREC"),U,3),",")
+6 SET DR=.12
+7 DO ^DIE
+8 KILL DIC,DR,DIE,DA
+9 QUIT
