AGEDPRVP ;IHS/ASDS/TPF - EDIT POLICY HOLDER FIELDS ;
;;7.1;PATIENT REGISTRATION;**1,2,3,8**;AUG 25, 2005
;ALL CALLS TO THIS ROUTINE WILL BE FOR EDITING POLICY HOLDER FIELDS
;
Q
;SOURCE = CALLED WHEN ADDING OR EDITING?
ADDMEMB(ID0,POLHPTR,AGINSPTR,SOURCE,POLMEMBS) ;EP - ADD POLICY MEMBER
N NMEMPTR
K DIC,DIE,DR,DIR,DA,DO,DD,DINUM
S DIC="^DPT("
S DIC(0)="QEAM"
S DIC("A")="Select Member to Add..: "
S TEMPDFN=DFN
D ^DIC
S DFN=TEMPDFN
Q:Y<0
S NMEMPTR=+Y
K DIC,DIE,DR,DIR,DA
;I $D(^AUPN3PPH("C",NMEMPTR,POLHPTR)) W !,"ALREADY A MEMBER!" H 3 Q
I $D(^AUPNPRVT("C",POLHPTR,NMEMPTR)) W !,"ALREADY A MEMBER!" H 3 Q ;IHS/SD/TPF 6/5/2006 IM20982
;IF PATIENT DOES NOT HAVE AN ENTRY IN THE INSURER FILE CREATE ONE
I '$D(^AUPNPRVT(NMEMPTR)) D Q:+Y<0
.K DIC,DA,DD,DO,DIR,DIE,DIR,X,DINUM
.S DIC="^AUPNPRVT("
.S DIC(0)="L"
.S (X,DINUM)=NMEMPTR
.S TEMPDFN=DFN
.D FILE^DICN
.S DFN=TEMPDFN
.K DA,DIC,DIR,DD,DO,DIE,DIR,X,DINUM
;
K DA,DIC,DIR,DD,DO,DIE,DIR,X,DINUM
I '$D(^AUPNPRVT(NMEMPTR,11,0)) S DIC("P")=$P(^DD(9000006,1101,0),U,2)
S DIC(0)="L"
S DA(1)=NMEMPTR
S X=AGINSPTR
S DIC="^AUPNPRVT("_DA(1)_",11,"
D FILE^DICN
I +Y<0 D CLEANUP Q
S NPVTENT=+Y
K DA,DIC,DIR,DD,DO,DIE,DIR,X,DINUM,Y
I SOURCE="A" D ADDOPT^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR,.POLMEMBS) Q
D PHEDALL(NMEMPTR,NPVTENT,POLHPTR)
Q
;CALLED WHEN ADDING PRVT INSURANCE FROM SUMMARY PAGE
PHEDALL(NMEMPTR,NPVTENT,POLHPTR,SAME,TYPE) ;EP - EDIT THE INDIVIDUAL FIELDS TO COMPLETE ADDING MEMBER
D EDITREL^AGEDPRVI(NMEMPTR,NPVTENT,SAME)
D EDITNAME^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR,"S")
D EDITNAME^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR,"E")
D EDITADDR(POLHPTR)
D EDITCITY(POLHPTR)
D EDITSTAT(POLHPTR)
D EDITZIP(POLHPTR)
D EDITPHON(POLHPTR)
D EDITPOLN(POLHPTR)
D EFFDT(POLHPTR)
D EDITBDT^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR,"S")
D EDITEXP(POLHPTR)
D EDITEDT^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR,"S")
D EDITGEN(POLHPTR)
D EDITDOB(POLHPTR)
D EDITEMPL(POLHPTR)
D EDITEMP(POLHPTR)
D EDITGRP(POLHPTR)
D EDITCOV(POLHPTR)
D EDITPCD^AGEDPRVI(NMEMPTR,NPVTENT)
D EDITPCP^AGEDPRVI(NMEMPTR,NPVTENT)
D EDITMNUM^AGEDPRVI(NMEMPTR,NPVTENT)
D EDITCC^AGEDPRVI(NMEMPTR,NPVTENT)
D EDITPH^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR)
D UPDATE1^AGED(DUZ(2),NMEMPTR,7,NPVTENT)
Q
ADDPOLH(NMEMPTR,NPVTENT,NEWPOLH,POLHPTR,REGISTER,SAME) ;EP - ADD NEW POLICY HOLDER TO POLICY HOLDER FILE
K DIE,DIC,DO,DD,DR,DIR,DA,DINUM
S X=NEWPOLH
S DIC(0)=""
;S DR=".01"
S DIC("DR")="" ;AG*7.1*2 FOUND DURING ALPHA
;I REGISTER S DR=DR_";.02///"_NMEMPTR
;I REGISTER S DIC("DR")=DIC("DR")_".02///"_NMEMPTR ;AG*7.1*2 FOUND DURING ALPHA
;S DIC("DR")=DIC("DR")_$S(DIC("DR")="":".03///",1:";.03///")_AGINSPTR ;AG*7.1*2 FOUND DURING ALPHA
I REGISTER S DIC("DR")=DIC("DR")_".02////"_NMEMPTR ;AG*7.1*2 FOUND DURING ALPHA
S DIC("DR")=DIC("DR")_$S(DIC("DR")="":".03////",1:";.03////")_AGINSPTR ;AG*7.1*3 IM23952
S DIC="^AUPN3PPH("
D FILE^DICN
Q:Y<0
S POLHPTR=+Y
D PHEDALL(NMEMPTR,NPVTENT,POLHPTR,SAME,"E")
K DIE,DIC,DO,DD,DR,DIR,DA,DINUM
Q
EDITEM1(PATPTR,POLHPTR) ;EP - EDIT ITEM 1 ON PAGE 1. ALLOWS EDIT OF
;NAME,STREET,CITY,STATE,ZIP AND PHONE
S NONREG=0,EXIT=0
D POLHCHK(PATPTR,.POLHPTR,.EXIT) I $G(EXIT)&('NONREG) K EXIT Q
W !
S DIE="^AUPN3PPH("
S DA=POLHPTR
S DR=".01Name as Stated on Policy..: "
S DR=DR_";.09;.11;.12;.13;.14"
D ^DIE
Q
POLHCHK(PATPTR,POLHPTR,EXIT) ;EP - CHECK THE POLICY HOLDER LINKAGE
Q:$G(POLHPTR)=""
N TARGET,PTR
I $$ISREG(POLHPTR,.PTR) D Q:$G(NEWLINK)!(NONREG)!(EXIT)
.W !!?5,"The Policy Holder is presently linked to "
.W $P($G(^DPT(PTR,0)),U),$S($D(^AUPNPAT(PTR,41,DUZ(2),0)):" ["_$P($G(^AUPNPAT(PTR,41,DUZ(2),0)),U,2)_"]",1:"")
.W !?5,"in your Patient Registration data base."
.K DIR
.W !
.S DIR("A")="Want to REMOVE the linkage with this Registered Patient (Y/N)"
.S DIR(0)="Y",DIR("B")="N"
.D ^DIR
.K DIR
.I $D(DTOUT)!(Y=U)!(Y=0) S EXIT=1 Q
.I Y=1 D D CONT1 Q
..S NEWLINK=1
..S DIE="^AUPN3PPH("
..S DA=POLHPTR
..S DR=".02///@;.08///@;.19///@"
..D ^DIE
;
W !!,"Presently the POLICY HOLDER is NOT known as a REGISTERED PATIENT."
CONT1 ;EP - CONT ON
W !
K DIR
S DIR(0)="Y",DIR("B")="Y"
S DIR("A")="Want to SCAN to see if the Policy Holder is Registered"
D ^DIR
K DIR
Q:$D(DTOUT)!(Y=U)
I Y=0 S NONREG=1 Q
CONT2 ;
K DIC,DIE,DIR,DR,DA
S DIC(0)="QZEAM",DIC="^AUPNPAT("
S TEMPDFN=$G(DFN)
D ^DIC
S DFN=TEMPDFN
K DIC,DIE,DIR,DR,DA
I +Y<0 Q
S TARGET=+Y
W !
K DIC,DIE,DIR,DR,DA
S DIR(0)="Y",DIR("B")="Y"
S DIR("A")="Is "_Y(0,0)_" the Policy Holder (Y/N)"
D ^DIR
K DIC,DIE,DIR,DR,DA
Q:$D(DTOUT)!(Y=U)
I Y=0 K TARGET G CONT2
K DIC,DIE,DIR,DR,DA
S DIE="^AUPN3PPH("
S DA=POLHPTR
S DR=".02////"_TARGET
D ^DIE
K DIC,DIE,DIR,DR,DA
Q
NAME(POLHPTR) ;EP - EDIT
W !
S DIE="^AUPN3PPH(",DA=POLHPTR
S DR=".01Name as Stated on Policy..: "
S DR=DR_";.09;.11;.12;.13;.14"
D ^DIE
Q
ISREG(POLHPTR,PTR) ;EP - IS THE POLICY HOLDER REGISTERED?
Q:$G(POLHPTR)="" 0
S PTR=$P($G(^AUPN3PPH(POLHPTR,0)),U,2) Q:'PTR 0
Q $D(^DPT(PTR))
;
EDITPH(POLHPTR) ;EP - EDIT POLICY HOLDER NAME
K DR,DIE,DIC,DA,DIR
W !
S DIE="^AUPN3PPH("
S DA=POLHPTR
S DR=".01Name as Stated on Policy..: "
D ^DIE
K DR,DIE,DIC,DA,DIR
Q
EDITGEN(POLHPTR,CALLER) ;EP - EDIT POLICY HOLDER GENDER
K DR,DIE,DIC,DA,DIR
I $G(CALLER)="SCREEN" W !!
S DIE="^AUPN3PPH("
S DA=POLHPTR
S DR=.08
D ^DIE
K DR,DIE,DIC,DA,DIR
Q
EDITPOLN(POLHPTR) ;EP - EDIT POLICY NUMBER
K DR,DIE,DIC,DA,DIR
S DR=".04R~[2] Policy or SSN...: "
S DIE("NO^")=""
S DIE="^AUPN3PPH("
S DA=POLHPTR
D ^DIE
K DR,DIE,DIC,DA,DIR
Q
EDITDOB(POLHPTR,CALLER) ;EP - EDIT DOB
K DR,DIE,DIC,DA,DIR
I $G(CALLER)="SCREEN" W !!
S DIE="^AUPN3PPH("
S DA=POLHPTR
S DR=.19
D ^DIE
K DR,DIE,DIC,DA,DIR
Q
EFFDT(POLHPTR) ;EP - EDIT EFFECTIVE DATE
EFFDT1 K DR,DIE,DIC,DA,DIR
N AGOLDDT
S AGOLDDT=$$GET1^DIQ(9000003.1,POLHPTR_",",.17,"") ;AG*7.1*2 IM20317
S DR=".17R~[3] Effective Date..: "
S DIE("NO^")=""
S DIE="^AUPN3PPH("
S DA=POLHPTR
D ^DIE
;AG*7.1*2 FOUND IN TESTING
I $$GET1^DIQ(9000003.1,POLHPTR_",",.18,"I"),($$GET1^DIQ(9000003.1,POLHPTR_",",.17,"I")>$$GET1^DIQ(9000003.1,POLHPTR_",",.18,"I")) D G EFFDT1
.W !!,"EFFECTIVE DATE CANNOT BE GREATER THAN TERMINATION DATE!" H 3
;BEGIN IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
S AGNEWDT=$P($G(^AUPN3PPH(POLHPTR,0)),U,17)
Q:AGOLDDT=AGNEWDT ;QUIT IF NO CHANGE
D UPDEFF(POLHPTR,AGNEWDT,AGOLDDT) ;UPDATE POL H EFF DATE
;IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
K DR,DIE,DIC,DA,DIR
;AUTO UPDATE THE EFF DT IN PRVT ELIG
;ONLY IF THE POL H IS REGISTERED PATIENT
;I $G(POLMEMBS("SELF"))=AGPATDFN D Q
;.S DA(1)=AGPATDFN
;.S DIE="^AUPNPRVT("_DA(1)_",11,"
;.S DA=$P(COMPIEN,",",3)
;.S DR=".06///^S X=$$GET1^DIQ(9000003.1,POLHPTR_"","",.17,""E"")"
;.D ^DIE
;.K DIC,DR,DIE,DA,DIR
Q
UPDEFF(POLHPTR,AGNEWDT,AGOLDDT) ;EP - IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
N POLMEM,RECNO
K DIE,DR,DIC,DIR,DA
S POLMEM=""
F S POLMEM=$O(^AUPNPRVT("C",POLHPTR,POLMEM)) Q:'POLMEM D
.S RECNO=""
.S RECNO=$O(^AUPNPRVT("C",POLHPTR,POLMEM,RECNO)) Q:'RECNO D
.S DA(1)=POLMEM
.S DA=RECNO
.I ($G(POLMEMBS("SELF"))'=POLMEM) Q ;DON'T UPDATE IF THEY HAVE SOMETHING ENTERED.
.S DR=".06///^S X=AGNEWDT"
.S DIE="^AUPNPRVT("_DA(1)_",11,"
.D ^DIE
K DIE,DR,DIC,DIR,DA
;IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
Q
EDITEXP(POLHPTR) ;EP - EDIT EXPIRATION DATE
K DIC,DA,DIE,DIR,DR
N AGOLDDT
S AGOLDDT=$$GET1^DIQ(9000003.1,POLHPTR_",",.18,"") ;AG*7.1*2 IM20317
S DR=".18[4] Expiration Date: "
S DIE="^AUPN3PPH("
S DA=POLHPTR
D ^DIE
;BEGIN IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
S AGNEWDT=$P($G(^AUPN3PPH(POLHPTR,0)),U,18)
Q:AGOLDDT=AGNEWDT ;QUIT IF NO CHANGE
D UPDTERM(POLHPTR,AGNEWDT,AGOLDDT) ;UPDATE ALL MEMBERS EXP DATE
;IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
K DR,DIE,DIC,DA,DIR
Q
UPDTERM(POLHPTR,AGNEWDT,AGOLDDT) ;EP - IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
N POLMEM,RECNO
K DIE,DR,DIC,DIR,DA
S POLMEM=""
F S POLMEM=$O(^AUPNPRVT("C",POLHPTR,POLMEM)) Q:'POLMEM D
.S RECNO=""
.S RECNO=$O(^AUPNPRVT("C",POLHPTR,POLMEM,RECNO)) Q:'RECNO D
.S DA(1)=POLMEM
.S DA=RECNO
.I $$GET1^DIQ(9000006.11,RECNO_","_POLMEM_",",.07)'="",($G(POLMEMBS("SELF"))'=POLMEM) Q ;DON'T UPDATE IF THEY HAVE SOMETHING ENTERED.
.I AGOLDDT'="",(AGNEWDT="") S DR=".07///@"
.E S DR=".07///^S X=AGNEWDT"
.S DIE="^AUPNPRVT("_DA(1)_",11,"
.D ^DIE
K DIE,DR,DIC,DIR,DA
;IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
Q
EDITEMPL(POLHPTR,TYPE,DATA,CALLER) ;EP - EDIT EMPLOYMENT STATUS
K DIE,DIC,DR,DA,DIR
I $G(CALLER)="SCREEN" W !!
I $G(TYPE)="S" S DR=".15///"_$G(DATA)
E S DR=.15
S DIE="^AUPN3PPH("
S DA=POLHPTR
D ^DIE
K DIE,DIC,DR,DA,DIR
Q
EDITEMP(POLHPTR,CALLER) ;EP - EDIT EMPLOYER
K DIE,DIC,DR,DA,DIR
I $G(CALLER)="SCREEN" W !!
S DIE="^AUPN3PPH("
S DR=".16"
S DA=POLHPTR
D ^DIE
S EMPLPTR=$P($G(^AUPN3PPH(POLHPTR,0)),U,16)
I EMPLPTR="" D EDITEMPL(POLHPTR,"S",9) Q
K DIE,DIC,DR,DA,DIR
S DIE="^AUTNEMPL("
S DA=EMPLPTR
W !!,"<---------EDIT EMPLOYER DEMOGRAPHICS--------->"
S DR=".02;.03:;.04"
S DR=DR_";.05;.06"
D ^DIE
K DIE,DIC,DR,DA,DIR
Q
EDITGRP(POLHPTR,CALLER) ;EP - EDIT GROUP NAME
;CHECKS TO SEE IF THEY ADDED A GROUP
N NMOFGRPS,NEWNMGRP,NEWGRP
S NMOFGRPS=$P($G(^AUTNEGRP(0)),U,4) ;NUMBER OF GROUPS IN FILE
K DIE,DIC,DR,DA,DIR
I $G(CALLER)="SCREEN" W !!
S DIE="^AUPN3PPH("
S DR=".06[11] Select GROUP NAME: "
S DA=POLHPTR
D ^DIE
K DIE,DIC,DR,DA,DIR
;
S NEWNMGRP=$P($G(^AUTNEGRP(0)),U,4) ;NOW HOW MANY GROUPS WERE ANY ADDED?
Q:NMOFGRPS=NEWNMGRP
Q:'$G(X) ;NOTHING ENTERED
I $D(Y) Q ;USER EXITED THE ROUTINE NO NEW GROUP WAS ADDED OR EDITED?
S NEWGRP=X
W !
W !!?5 W "NOTE: Some Insurers assign different Group Numbers based upon the"
W !?11,"particular type of visit (dental, outpatient, etc.) that"
W !?11,"occurred."
W !
K DIR
S DIR("B")="N"
S DIR(0)="Y"
S DIR("A")="Do the Group Numbers vary depending on Visit Type (Y/N)"
S DIR("B")=$S($O(^AUTNEGRP(NEWGRP,11,0)):"Y",1:"N")
D ^DIR
Q:$D(DTOUT)!(Y[U)!($D(DUOUT))
W !
I Y=0 D Q
.;EDIT GROUP #
.K DIE,DIC,DR,DA,DIR
.S DIE="^AUTNEGRP("
.S DA=NEWGRP
.S DR=".02R"
.D ^DIE
.K DIE,DIC,DR,DA,DIR
;EDIT VISIT TYPE
K DIE,DIC,DR,DA,DIR
S DA=NEWGRP
S DIE="^AUTNEGRP("
S DR="11"
D ^DIE
K DIE,DIC,DR,DA,DIR
Q
EDITADDR(POLHPTR) ;EP - EDIT PH ADDRESS
K DIE,DIC,DR,DA,DIR
S DIE="^AUPN3PPH("
S DR=".09"
S DA=POLHPTR
D ^DIE
K DIE,DIC,DR,DA,DIR
Q
EDITCITY(POLHPTR) ;EP - EDIT PH CITY
K DIE,DIC,DR,DA,DIR
S DIE="^AUPN3PPH("
S DR=".11"
S DA=POLHPTR
D ^DIE
K DIE,DIC,DR,DA,DIR
Q
EDITSTAT(POLHPTR) ;EP - EDIT PH STATE
K DIE,DIC,DR,DA,DIR
S DIE="^AUPN3PPH("
S DR=".12"
S DA=POLHPTR
D ^DIE
K DIE,DIC,DR,DA,DIR
Q
EDITZIP(POLHPTR) ;EP - EDIT PH ZIP
K DIE,DIC,DR,DA,DIR
S DIE="^AUPN3PPH("
S DR=".13"
S DA=POLHPTR
D ^DIE
K DIE,DIC,DR,DA,DIR
Q
EDITPHON(POLHPTR) ;EP - EDIT PH PHONE
K DIE,DIC,DR,DA,DIR
S DIE="^AUPN3PPH("
S DR=".14"
S DA=POLHPTR
D ^DIE
K DIE,DIC,DR,DA,DIR
Q
EDCARDNM(POLHPTR) ;EP - EDIT CARD NAME
K DIE,DIC,DR,DA,DIR
S DIE="^AUPN3PPH("
S DR="2[8] CD Name: " ;AG*7.1*8
S DA=POLHPTR
D ^DIE
K DIE,DIC,DR,DA,DIR
Q
EDITCOV(POLHPTR,CALLER) ;EP - EDIT COVERAGE TYPE
K DIE,DIC,DR,DA,DIR
I $G(CALLER)="SCREEN" W !!
S DIE="^AUPN3PPH("
S DR=".05[12] Select COVERAGE TYPE: "
S DA=POLHPTR
D ^DIE
S COVPTR=$P($G(^AUPN3PPH(POLHPTR,0)),U,5)
S:$G(AGINSREC)'="" $P(AGINSREC,U,3)=$P($G(^AUPN3PPH(POLHPTR,0)),U,5)
K DIE,DIC,DR,DA,DIR
Q
CLEANUP(NMEMPTR) ;EP - CLEAN UP ENTRY IF NOT NEEDED
;IF ADDING AN INSURER FAILED THEN SEE IF THERE ANY
;INSURERS FOR THIS 11 NODE AT ALL. IF NOT DELETE THE TOP NODE
;THERE IS A CALL IN THE OLD CODE??
Q:$O(^AUPNPRVT(NMEMPTR,11,0)) ;IF ENTRIES LEAVE ALONE
S DA=NMEMPTR
S DIK="^AUPNPRVT("
D ^DIK
Q
DELMEM(POLHPTR,POLMCNT,POLMEMBS,LASTDEL,DELALL,CANCELED) ;EP - DELETE A POLICY MEMBER
N CNT,POLMEM,CHOICE,ITEM
W !!?5,"------------POLICY MEMBERS------------"
I '$D(POLMEMBS) W !!,"NO MEMBERS FOUND IN MEMBER LIST!" H 3 Q
S CNT=""
F ITEM=1:1 S CNT=$O(POLMEMBS(CNT)) Q:'CNT D
.W !?10,ITEM,")"
.S POLMEM=""
.F S POLMEM=$O(POLMEMBS(CNT,POLMEM)) Q:'POLMEM D
..W $P($G(^DPT(POLMEM,0)),U)
K DIR
S DIR(0)="NO^1:"_POLMCNT,DIR("A")=" DELETE which Member" D ^DIR K DIR
Q:+Y<1
S CHOICE=$O(POLMEMBS(Y+13,""))
S RECORD=$O(POLMEMBS(Y+13,CHOICE,""))
I $G(POLMEMBS("SELF"))=CHOICE D Q:'Y
.W !,"THIS IS THE POLICY HOLDER. IF YOU DELETE THE POLICY HOLDER"
.W !,"THE PRIVATE INSURANCE ELIGIBILITIES OF ALL MEMBERS OF THIS"
.W !,"POLICY WILL BE DELETED INCLUDING THE POLICY HOLDER"
.W !,"DO YOU REALLY WANT TO DO THIS?"
.K DIR
.S DIR("B")="N"
.S DIR(0)="Y"
.D ^DIR
.S DELALL=Y=1
;DELETE ALL MEMBERS INCLUDING POLICY HOLDER
I $G(DELALL) D DELALL(.POLMEMBS,POLHPTR,.CANCELED) Q
;DELETE ONE MEMBER
;
D DELETE(CHOICE,RECORD,.CANCELED)
Q
DELALL(POLMEMBS,POLHPTR,CANCELED) ;EP - DELETE ALL POLICY MEMBERS INCLUDING POLICY HOLDER
Q:'$D(POLMEMBS)
N ITEM
S ITEM=""
F S ITEM=$O(POLMEMBS(ITEM)) Q:'ITEM D Q:$G(CANCELED)
.S CHOICE=$O(POLMEMBS(ITEM,""))
.S RECORD=$O(POLMEMBS(ITEM,CHOICE,""))
.D DELETE(CHOICE,RECORD,.CANCELED)
Q:$G(CANCELED)
;
;SINCE WE ARE DELETING ALL MEMBERS INCLUDING THE HOLDER,
;DELETE THE POLICY HOLDER ENTRY AS WELL
K DIE,DIC,DIK,DA,DIR
S DA=$G(POLHPTR)
S DIK="^AUPN3PPH("
D ^DIK
K POLMEMBS
Q
DELETE(CHOICE,RECORD,CANCELED) ;EP - DELETE MEMBER
Q:'$G(CHOICE)!('$G(RECORD))
;CHECK IF THERE ARE BILLS OR CLAIMS OUTSTANDING FOR THIS MEMBER
S IN3PB=$$USED^AGUTILS(CHOICE,"",8,RECORD)
I $L(IN3PB) D Q:$G(CANCELED)
.W !?15,"WARNING: This member has outstanding claims and/or bills!!!"
.W !?24,"Deleting this member may cause data integrity problems"
.W !?24,"in the Third Party Billing package!!"
.K DIR,DIE,DA,DIC,DR
.S DIR(0)="Y"
.S DIR("B")="N"
.S DIR("A")="Continue to delete?"
.D ^DIR
.S CANCELED=Y=0
K DIE,DIC,DIK,DA,DIR
S DA(1)=$G(CHOICE)
S DIK="^AUPNPRVT("_DA(1)_",11,"
S DA=$G(RECORD)
D ^DIK
K DIE,DIC,DIK,DA,DIR
;IF THIS IS THE LAST PRIVATE INSURER STORED FOR THIS PATIENT THEN
;CLEAN UP TOP RECORD
I '$O(^AUPNPRVT(CHOICE,11,0)) D
.K DIE,DIC,DIK,DA,DIR
.S DA=$G(CHOICE)
.S DIK="^AUPNPRVT("
.D ^DIK
.K DIE,DIC,DIK,DA,DIR
Q
AGEDPRVP ;IHS/ASDS/TPF - EDIT POLICY HOLDER FIELDS ;
+1 ;;7.1;PATIENT REGISTRATION;**1,2,3,8**;AUG 25, 2005
+2 ;ALL CALLS TO THIS ROUTINE WILL BE FOR EDITING POLICY HOLDER FIELDS
+3 ;
+4 QUIT
+5 ;SOURCE = CALLED WHEN ADDING OR EDITING?
ADDMEMB(ID0,POLHPTR,AGINSPTR,SOURCE,POLMEMBS) ;EP - ADD POLICY MEMBER
+1 NEW NMEMPTR
+2 KILL DIC,DIE,DR,DIR,DA,DO,DD,DINUM
+3 SET DIC="^DPT("
+4 SET DIC(0)="QEAM"
+5 SET DIC("A")="Select Member to Add..: "
+6 SET TEMPDFN=DFN
+7 DO ^DIC
+8 SET DFN=TEMPDFN
+9 IF Y<0
QUIT
+10 SET NMEMPTR=+Y
+11 KILL DIC,DIE,DR,DIR,DA
+12 ;I $D(^AUPN3PPH("C",NMEMPTR,POLHPTR)) W !,"ALREADY A MEMBER!" H 3 Q
+13 ;IHS/SD/TPF 6/5/2006 IM20982
IF $DATA(^AUPNPRVT("C",POLHPTR,NMEMPTR))
WRITE !,"ALREADY A MEMBER!"
HANG 3
QUIT
+14 ;IF PATIENT DOES NOT HAVE AN ENTRY IN THE INSURER FILE CREATE ONE
+15 IF '$DATA(^AUPNPRVT(NMEMPTR))
Begin DoDot:1
+16 KILL DIC,DA,DD,DO,DIR,DIE,DIR,X,DINUM
+17 SET DIC="^AUPNPRVT("
+18 SET DIC(0)="L"
+19 SET (X,DINUM)=NMEMPTR
+20 SET TEMPDFN=DFN
+21 DO FILE^DICN
+22 SET DFN=TEMPDFN
+23 KILL DA,DIC,DIR,DD,DO,DIE,DIR,X,DINUM
End DoDot:1
IF +Y<0
QUIT
+24 ;
+25 KILL DA,DIC,DIR,DD,DO,DIE,DIR,X,DINUM
+26 IF '$DATA(^AUPNPRVT(NMEMPTR,11,0))
SET DIC("P")=$PIECE(^DD(9000006,1101,0),U,2)
+27 SET DIC(0)="L"
+28 SET DA(1)=NMEMPTR
+29 SET X=AGINSPTR
+30 SET DIC="^AUPNPRVT("_DA(1)_",11,"
+31 DO FILE^DICN
+32 IF +Y<0
DO CLEANUP
QUIT
+33 SET NPVTENT=+Y
+34 KILL DA,DIC,DIR,DD,DO,DIE,DIR,X,DINUM,Y
+35 IF SOURCE="A"
DO ADDOPT^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR,.POLMEMBS)
QUIT
+36 DO PHEDALL(NMEMPTR,NPVTENT,POLHPTR)
+37 QUIT
+38 ;CALLED WHEN ADDING PRVT INSURANCE FROM SUMMARY PAGE
PHEDALL(NMEMPTR,NPVTENT,POLHPTR,SAME,TYPE) ;EP - EDIT THE INDIVIDUAL FIELDS TO COMPLETE ADDING MEMBER
+1 DO EDITREL^AGEDPRVI(NMEMPTR,NPVTENT,SAME)
+2 DO EDITNAME^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR,"S")
+3 DO EDITNAME^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR,"E")
+4 DO EDITADDR(POLHPTR)
+5 DO EDITCITY(POLHPTR)
+6 DO EDITSTAT(POLHPTR)
+7 DO EDITZIP(POLHPTR)
+8 DO EDITPHON(POLHPTR)
+9 DO EDITPOLN(POLHPTR)
+10 DO EFFDT(POLHPTR)
+11 DO EDITBDT^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR,"S")
+12 DO EDITEXP(POLHPTR)
+13 DO EDITEDT^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR,"S")
+14 DO EDITGEN(POLHPTR)
+15 DO EDITDOB(POLHPTR)
+16 DO EDITEMPL(POLHPTR)
+17 DO EDITEMP(POLHPTR)
+18 DO EDITGRP(POLHPTR)
+19 DO EDITCOV(POLHPTR)
+20 DO EDITPCD^AGEDPRVI(NMEMPTR,NPVTENT)
+21 DO EDITPCP^AGEDPRVI(NMEMPTR,NPVTENT)
+22 DO EDITMNUM^AGEDPRVI(NMEMPTR,NPVTENT)
+23 DO EDITCC^AGEDPRVI(NMEMPTR,NPVTENT)
+24 DO EDITPH^AGEDPRVI(NMEMPTR,NPVTENT,POLHPTR)
+25 DO UPDATE1^AGED(DUZ(2),NMEMPTR,7,NPVTENT)
+26 QUIT
ADDPOLH(NMEMPTR,NPVTENT,NEWPOLH,POLHPTR,REGISTER,SAME) ;EP - ADD NEW POLICY HOLDER TO POLICY HOLDER FILE
+1 KILL DIE,DIC,DO,DD,DR,DIR,DA,DINUM
+2 SET X=NEWPOLH
+3 SET DIC(0)=""
+4 ;S DR=".01"
+5 ;AG*7.1*2 FOUND DURING ALPHA
SET DIC("DR")=""
+6 ;I REGISTER S DR=DR_";.02///"_NMEMPTR
+7 ;I REGISTER S DIC("DR")=DIC("DR")_".02///"_NMEMPTR ;AG*7.1*2 FOUND DURING ALPHA
+8 ;S DIC("DR")=DIC("DR")_$S(DIC("DR")="":".03///",1:";.03///")_AGINSPTR ;AG*7.1*2 FOUND DURING ALPHA
+9 ;AG*7.1*2 FOUND DURING ALPHA
IF REGISTER
SET DIC("DR")=DIC("DR")_".02////"_NMEMPTR
+10 ;AG*7.1*3 IM23952
SET DIC("DR")=DIC("DR")_$SELECT(DIC("DR")="":".03////",1:";.03////")_AGINSPTR
+11 SET DIC="^AUPN3PPH("
+12 DO FILE^DICN
+13 IF Y<0
QUIT
+14 SET POLHPTR=+Y
+15 DO PHEDALL(NMEMPTR,NPVTENT,POLHPTR,SAME,"E")
+16 KILL DIE,DIC,DO,DD,DR,DIR,DA,DINUM
+17 QUIT
EDITEM1(PATPTR,POLHPTR) ;EP - EDIT ITEM 1 ON PAGE 1. ALLOWS EDIT OF
+1 ;NAME,STREET,CITY,STATE,ZIP AND PHONE
+2 SET NONREG=0
SET EXIT=0
+3 DO POLHCHK(PATPTR,.POLHPTR,.EXIT)
IF $GET(EXIT)&('NONREG)
KILL EXIT
QUIT
+4 WRITE !
+5 SET DIE="^AUPN3PPH("
+6 SET DA=POLHPTR
+7 SET DR=".01Name as Stated on Policy..: "
+8 SET DR=DR_";.09;.11;.12;.13;.14"
+9 DO ^DIE
+10 QUIT
POLHCHK(PATPTR,POLHPTR,EXIT) ;EP - CHECK THE POLICY HOLDER LINKAGE
+1 IF $GET(POLHPTR)=""
QUIT
+2 NEW TARGET,PTR
+3 IF $$ISREG(POLHPTR,.PTR)
Begin DoDot:1
+4 WRITE !!?5,"The Policy Holder is presently linked to "
+5 WRITE $PIECE($GET(^DPT(PTR,0)),U),$SELECT($DATA(^AUPNPAT(PTR,41,DUZ(2),0)):" ["_$PIECE($GET(^AUPNPAT(PTR,41,DUZ(2),0)),U,2)_"]",1:"")
+6 WRITE !?5,"in your Patient Registration data base."
+7 KILL DIR
+8 WRITE !
+9 SET DIR("A")="Want to REMOVE the linkage with this Registered Patient (Y/N)"
+10 SET DIR(0)="Y"
SET DIR("B")="N"
+11 DO ^DIR
+12 KILL DIR
+13 IF $DATA(DTOUT)!(Y=U)!(Y=0)
SET EXIT=1
QUIT
+14 IF Y=1
Begin DoDot:2
+15 SET NEWLINK=1
+16 SET DIE="^AUPN3PPH("
+17 SET DA=POLHPTR
+18 SET DR=".02///@;.08///@;.19///@"
+19 DO ^DIE
End DoDot:2
DO CONT1
QUIT
End DoDot:1
IF $GET(NEWLINK)!(NONREG)!(EXIT)
QUIT
+20 ;
+21 WRITE !!,"Presently the POLICY HOLDER is NOT known as a REGISTERED PATIENT."
CONT1 ;EP - CONT ON
+1 WRITE !
+2 KILL DIR
+3 SET DIR(0)="Y"
SET DIR("B")="Y"
+4 SET DIR("A")="Want to SCAN to see if the Policy Holder is Registered"
+5 DO ^DIR
+6 KILL DIR
+7 IF $DATA(DTOUT)!(Y=U)
QUIT
+8 IF Y=0
SET NONREG=1
QUIT
CONT2 ;
+1 KILL DIC,DIE,DIR,DR,DA
+2 SET DIC(0)="QZEAM"
SET DIC="^AUPNPAT("
+3 SET TEMPDFN=$GET(DFN)
+4 DO ^DIC
+5 SET DFN=TEMPDFN
+6 KILL DIC,DIE,DIR,DR,DA
+7 IF +Y<0
QUIT
+8 SET TARGET=+Y
+9 WRITE !
+10 KILL DIC,DIE,DIR,DR,DA
+11 SET DIR(0)="Y"
SET DIR("B")="Y"
+12 SET DIR("A")="Is "_Y(0,0)_" the Policy Holder (Y/N)"
+13 DO ^DIR
+14 KILL DIC,DIE,DIR,DR,DA
+15 IF $DATA(DTOUT)!(Y=U)
QUIT
+16 IF Y=0
KILL TARGET
GOTO CONT2
+17 KILL DIC,DIE,DIR,DR,DA
+18 SET DIE="^AUPN3PPH("
+19 SET DA=POLHPTR
+20 SET DR=".02////"_TARGET
+21 DO ^DIE
+22 KILL DIC,DIE,DIR,DR,DA
+23 QUIT
NAME(POLHPTR) ;EP - EDIT
+1 WRITE !
+2 SET DIE="^AUPN3PPH("
SET DA=POLHPTR
+3 SET DR=".01Name as Stated on Policy..: "
+4 SET DR=DR_";.09;.11;.12;.13;.14"
+5 DO ^DIE
+6 QUIT
ISREG(POLHPTR,PTR) ;EP - IS THE POLICY HOLDER REGISTERED?
+1 IF $GET(POLHPTR)=""
QUIT 0
+2 SET PTR=$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U,2)
IF 'PTR
QUIT 0
+3 QUIT $DATA(^DPT(PTR))
+4 ;
EDITPH(POLHPTR) ;EP - EDIT POLICY HOLDER NAME
+1 KILL DR,DIE,DIC,DA,DIR
+2 WRITE !
+3 SET DIE="^AUPN3PPH("
+4 SET DA=POLHPTR
+5 SET DR=".01Name as Stated on Policy..: "
+6 DO ^DIE
+7 KILL DR,DIE,DIC,DA,DIR
+8 QUIT
EDITGEN(POLHPTR,CALLER) ;EP - EDIT POLICY HOLDER GENDER
+1 KILL DR,DIE,DIC,DA,DIR
+2 IF $GET(CALLER)="SCREEN"
WRITE !!
+3 SET DIE="^AUPN3PPH("
+4 SET DA=POLHPTR
+5 SET DR=.08
+6 DO ^DIE
+7 KILL DR,DIE,DIC,DA,DIR
+8 QUIT
EDITPOLN(POLHPTR) ;EP - EDIT POLICY NUMBER
+1 KILL DR,DIE,DIC,DA,DIR
+2 SET DR=".04R~[2] Policy or SSN...: "
+3 SET DIE("NO^")=""
+4 SET DIE="^AUPN3PPH("
+5 SET DA=POLHPTR
+6 DO ^DIE
+7 KILL DR,DIE,DIC,DA,DIR
+8 QUIT
EDITDOB(POLHPTR,CALLER) ;EP - EDIT DOB
+1 KILL DR,DIE,DIC,DA,DIR
+2 IF $GET(CALLER)="SCREEN"
WRITE !!
+3 SET DIE="^AUPN3PPH("
+4 SET DA=POLHPTR
+5 SET DR=.19
+6 DO ^DIE
+7 KILL DR,DIE,DIC,DA,DIR
+8 QUIT
EFFDT(POLHPTR) ;EP - EDIT EFFECTIVE DATE
EFFDT1 KILL DR,DIE,DIC,DA,DIR
+1 NEW AGOLDDT
+2 ;AG*7.1*2 IM20317
SET AGOLDDT=$$GET1^DIQ(9000003.1,POLHPTR_",",.17,"")
+3 SET DR=".17R~[3] Effective Date..: "
+4 SET DIE("NO^")=""
+5 SET DIE="^AUPN3PPH("
+6 SET DA=POLHPTR
+7 DO ^DIE
+8 ;AG*7.1*2 FOUND IN TESTING
+9 IF $$GET1^DIQ(9000003.1,POLHPTR_",",.18,"I")
IF ($$GET1^DIQ(9000003.1,POLHPTR_",",.17,"I")>$$GET1^DIQ(9000003.1,POLHPTR_",",.18,"I"))
Begin DoDot:1
+10 WRITE !!,"EFFECTIVE DATE CANNOT BE GREATER THAN TERMINATION DATE!"
HANG 3
End DoDot:1
GOTO EFFDT1
+11 ;BEGIN IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
+12 SET AGNEWDT=$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U,17)
+13 ;QUIT IF NO CHANGE
IF AGOLDDT=AGNEWDT
QUIT
+14 ;UPDATE POL H EFF DATE
DO UPDEFF(POLHPTR,AGNEWDT,AGOLDDT)
+15 ;IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
+16 KILL DR,DIE,DIC,DA,DIR
+17 ;AUTO UPDATE THE EFF DT IN PRVT ELIG
+18 ;ONLY IF THE POL H IS REGISTERED PATIENT
+19 ;I $G(POLMEMBS("SELF"))=AGPATDFN D Q
+20 ;.S DA(1)=AGPATDFN
+21 ;.S DIE="^AUPNPRVT("_DA(1)_",11,"
+22 ;.S DA=$P(COMPIEN,",",3)
+23 ;.S DR=".06///^S X=$$GET1^DIQ(9000003.1,POLHPTR_"","",.17,""E"")"
+24 ;.D ^DIE
+25 ;.K DIC,DR,DIE,DA,DIR
+26 QUIT
UPDEFF(POLHPTR,AGNEWDT,AGOLDDT) ;EP - IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
+1 NEW POLMEM,RECNO
+2 KILL DIE,DR,DIC,DIR,DA
+3 SET POLMEM=""
+4 FOR
SET POLMEM=$ORDER(^AUPNPRVT("C",POLHPTR,POLMEM))
IF 'POLMEM
QUIT
Begin DoDot:1
+5 SET RECNO=""
+6 SET RECNO=$ORDER(^AUPNPRVT("C",POLHPTR,POLMEM,RECNO))
IF 'RECNO
QUIT
Begin DoDot:2
End DoDot:2
+7 SET DA(1)=POLMEM
+8 SET DA=RECNO
+9 ;DON'T UPDATE IF THEY HAVE SOMETHING ENTERED.
IF ($GET(POLMEMBS("SELF"))'=POLMEM)
QUIT
+10 SET DR=".06///^S X=AGNEWDT"
+11 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+12 DO ^DIE
End DoDot:1
+13 KILL DIE,DR,DIC,DIR,DA
+14 ;IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
+15 QUIT
EDITEXP(POLHPTR) ;EP - EDIT EXPIRATION DATE
+1 KILL DIC,DA,DIE,DIR,DR
+2 NEW AGOLDDT
+3 ;AG*7.1*2 IM20317
SET AGOLDDT=$$GET1^DIQ(9000003.1,POLHPTR_",",.18,"")
+4 SET DR=".18[4] Expiration Date: "
+5 SET DIE="^AUPN3PPH("
+6 SET DA=POLHPTR
+7 DO ^DIE
+8 ;BEGIN IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
+9 SET AGNEWDT=$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U,18)
+10 ;QUIT IF NO CHANGE
IF AGOLDDT=AGNEWDT
QUIT
+11 ;UPDATE ALL MEMBERS EXP DATE
DO UPDTERM(POLHPTR,AGNEWDT,AGOLDDT)
+12 ;IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
+13 KILL DR,DIE,DIC,DA,DIR
+14 QUIT
UPDTERM(POLHPTR,AGNEWDT,AGOLDDT) ;EP - IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
+1 NEW POLMEM,RECNO
+2 KILL DIE,DR,DIC,DIR,DA
+3 SET POLMEM=""
+4 FOR
SET POLMEM=$ORDER(^AUPNPRVT("C",POLHPTR,POLMEM))
IF 'POLMEM
QUIT
Begin DoDot:1
+5 SET RECNO=""
+6 SET RECNO=$ORDER(^AUPNPRVT("C",POLHPTR,POLMEM,RECNO))
IF 'RECNO
QUIT
Begin DoDot:2
End DoDot:2
+7 SET DA(1)=POLMEM
+8 SET DA=RECNO
+9 ;DON'T UPDATE IF THEY HAVE SOMETHING ENTERED.
IF $$GET1^DIQ(9000006.11,RECNO_","_POLMEM_",",.07)'=""
IF ($GET(POLMEMBS("SELF"))'=POLMEM)
QUIT
+10 IF AGOLDDT'=""
IF (AGNEWDT="")
SET DR=".07///@"
+11 IF '$TEST
SET DR=".07///^S X=AGNEWDT"
+12 SET DIE="^AUPNPRVT("_DA(1)_",11,"
+13 DO ^DIE
End DoDot:1
+14 KILL DIE,DR,DIC,DIR,DA
+15 ;IHS/SD/TPF 4/3/2006 AG*7.1*2 IM20317
+16 QUIT
EDITEMPL(POLHPTR,TYPE,DATA,CALLER) ;EP - EDIT EMPLOYMENT STATUS
+1 KILL DIE,DIC,DR,DA,DIR
+2 IF $GET(CALLER)="SCREEN"
WRITE !!
+3 IF $GET(TYPE)="S"
SET DR=".15///"_$GET(DATA)
+4 IF '$TEST
SET DR=.15
+5 SET DIE="^AUPN3PPH("
+6 SET DA=POLHPTR
+7 DO ^DIE
+8 KILL DIE,DIC,DR,DA,DIR
+9 QUIT
EDITEMP(POLHPTR,CALLER) ;EP - EDIT EMPLOYER
+1 KILL DIE,DIC,DR,DA,DIR
+2 IF $GET(CALLER)="SCREEN"
WRITE !!
+3 SET DIE="^AUPN3PPH("
+4 SET DR=".16"
+5 SET DA=POLHPTR
+6 DO ^DIE
+7 SET EMPLPTR=$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U,16)
+8 IF EMPLPTR=""
DO EDITEMPL(POLHPTR,"S",9)
QUIT
+9 KILL DIE,DIC,DR,DA,DIR
+10 SET DIE="^AUTNEMPL("
+11 SET DA=EMPLPTR
+12 WRITE !!,"<---------EDIT EMPLOYER DEMOGRAPHICS--------->"
+13 SET DR=".02;.03:;.04"
+14 SET DR=DR_";.05;.06"
+15 DO ^DIE
+16 KILL DIE,DIC,DR,DA,DIR
+17 QUIT
EDITGRP(POLHPTR,CALLER) ;EP - EDIT GROUP NAME
+1 ;CHECKS TO SEE IF THEY ADDED A GROUP
+2 NEW NMOFGRPS,NEWNMGRP,NEWGRP
+3 ;NUMBER OF GROUPS IN FILE
SET NMOFGRPS=$PIECE($GET(^AUTNEGRP(0)),U,4)
+4 KILL DIE,DIC,DR,DA,DIR
+5 IF $GET(CALLER)="SCREEN"
WRITE !!
+6 SET DIE="^AUPN3PPH("
+7 SET DR=".06[11] Select GROUP NAME: "
+8 SET DA=POLHPTR
+9 DO ^DIE
+10 KILL DIE,DIC,DR,DA,DIR
+11 ;
+12 ;NOW HOW MANY GROUPS WERE ANY ADDED?
SET NEWNMGRP=$PIECE($GET(^AUTNEGRP(0)),U,4)
+13 IF NMOFGRPS=NEWNMGRP
QUIT
+14 ;NOTHING ENTERED
IF '$GET(X)
QUIT
+15 ;USER EXITED THE ROUTINE NO NEW GROUP WAS ADDED OR EDITED?
IF $DATA(Y)
QUIT
+16 SET NEWGRP=X
+17 WRITE !
+18 WRITE !!?5
WRITE "NOTE: Some Insurers assign different Group Numbers based upon the"
+19 WRITE !?11,"particular type of visit (dental, outpatient, etc.) that"
+20 WRITE !?11,"occurred."
+21 WRITE !
+22 KILL DIR
+23 SET DIR("B")="N"
+24 SET DIR(0)="Y"
+25 SET DIR("A")="Do the Group Numbers vary depending on Visit Type (Y/N)"
+26 SET DIR("B")=$SELECT($ORDER(^AUTNEGRP(NEWGRP,11,0)):"Y",1:"N")
+27 DO ^DIR
+28 IF $DATA(DTOUT)!(Y[U)!($DATA(DUOUT))
QUIT
+29 WRITE !
+30 IF Y=0
Begin DoDot:1
+31 ;EDIT GROUP #
+32 KILL DIE,DIC,DR,DA,DIR
+33 SET DIE="^AUTNEGRP("
+34 SET DA=NEWGRP
+35 SET DR=".02R"
+36 DO ^DIE
+37 KILL DIE,DIC,DR,DA,DIR
End DoDot:1
QUIT
+38 ;EDIT VISIT TYPE
+39 KILL DIE,DIC,DR,DA,DIR
+40 SET DA=NEWGRP
+41 SET DIE="^AUTNEGRP("
+42 SET DR="11"
+43 DO ^DIE
+44 KILL DIE,DIC,DR,DA,DIR
+45 QUIT
EDITADDR(POLHPTR) ;EP - EDIT PH ADDRESS
+1 KILL DIE,DIC,DR,DA,DIR
+2 SET DIE="^AUPN3PPH("
+3 SET DR=".09"
+4 SET DA=POLHPTR
+5 DO ^DIE
+6 KILL DIE,DIC,DR,DA,DIR
+7 QUIT
EDITCITY(POLHPTR) ;EP - EDIT PH CITY
+1 KILL DIE,DIC,DR,DA,DIR
+2 SET DIE="^AUPN3PPH("
+3 SET DR=".11"
+4 SET DA=POLHPTR
+5 DO ^DIE
+6 KILL DIE,DIC,DR,DA,DIR
+7 QUIT
EDITSTAT(POLHPTR) ;EP - EDIT PH STATE
+1 KILL DIE,DIC,DR,DA,DIR
+2 SET DIE="^AUPN3PPH("
+3 SET DR=".12"
+4 SET DA=POLHPTR
+5 DO ^DIE
+6 KILL DIE,DIC,DR,DA,DIR
+7 QUIT
EDITZIP(POLHPTR) ;EP - EDIT PH ZIP
+1 KILL DIE,DIC,DR,DA,DIR
+2 SET DIE="^AUPN3PPH("
+3 SET DR=".13"
+4 SET DA=POLHPTR
+5 DO ^DIE
+6 KILL DIE,DIC,DR,DA,DIR
+7 QUIT
EDITPHON(POLHPTR) ;EP - EDIT PH PHONE
+1 KILL DIE,DIC,DR,DA,DIR
+2 SET DIE="^AUPN3PPH("
+3 SET DR=".14"
+4 SET DA=POLHPTR
+5 DO ^DIE
+6 KILL DIE,DIC,DR,DA,DIR
+7 QUIT
EDCARDNM(POLHPTR) ;EP - EDIT CARD NAME
+1 KILL DIE,DIC,DR,DA,DIR
+2 SET DIE="^AUPN3PPH("
+3 ;AG*7.1*8
SET DR="2[8] CD Name: "
+4 SET DA=POLHPTR
+5 DO ^DIE
+6 KILL DIE,DIC,DR,DA,DIR
+7 QUIT
EDITCOV(POLHPTR,CALLER) ;EP - EDIT COVERAGE TYPE
+1 KILL DIE,DIC,DR,DA,DIR
+2 IF $GET(CALLER)="SCREEN"
WRITE !!
+3 SET DIE="^AUPN3PPH("
+4 SET DR=".05[12] Select COVERAGE TYPE: "
+5 SET DA=POLHPTR
+6 DO ^DIE
+7 SET COVPTR=$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U,5)
+8 IF $GET(AGINSREC)'=""
SET $PIECE(AGINSREC,U,3)=$PIECE($GET(^AUPN3PPH(POLHPTR,0)),U,5)
+9 KILL DIE,DIC,DR,DA,DIR
+10 QUIT
CLEANUP(NMEMPTR) ;EP - CLEAN UP ENTRY IF NOT NEEDED
+1 ;IF ADDING AN INSURER FAILED THEN SEE IF THERE ANY
+2 ;INSURERS FOR THIS 11 NODE AT ALL. IF NOT DELETE THE TOP NODE
+3 ;THERE IS A CALL IN THE OLD CODE??
+4 ;IF ENTRIES LEAVE ALONE
IF $ORDER(^AUPNPRVT(NMEMPTR,11,0))
QUIT
+5 SET DA=NMEMPTR
+6 SET DIK="^AUPNPRVT("
+7 DO ^DIK
+8 QUIT
DELMEM(POLHPTR,POLMCNT,POLMEMBS,LASTDEL,DELALL,CANCELED) ;EP - DELETE A POLICY MEMBER
+1 NEW CNT,POLMEM,CHOICE,ITEM
+2 WRITE !!?5,"------------POLICY MEMBERS------------"
+3 IF '$DATA(POLMEMBS)
WRITE !!,"NO MEMBERS FOUND IN MEMBER LIST!"
HANG 3
QUIT
+4 SET CNT=""
+5 FOR ITEM=1:1
SET CNT=$ORDER(POLMEMBS(CNT))
IF 'CNT
QUIT
Begin DoDot:1
+6 WRITE !?10,ITEM,")"
+7 SET POLMEM=""
+8 FOR
SET POLMEM=$ORDER(POLMEMBS(CNT,POLMEM))
IF 'POLMEM
QUIT
Begin DoDot:2
+9 WRITE $PIECE($GET(^DPT(POLMEM,0)),U)
End DoDot:2
End DoDot:1
+10 KILL DIR
+11 SET DIR(0)="NO^1:"_POLMCNT
SET DIR("A")=" DELETE which Member"
DO ^DIR
KILL DIR
+12 IF +Y<1
QUIT
+13 SET CHOICE=$ORDER(POLMEMBS(Y+13,""))
+14 SET RECORD=$ORDER(POLMEMBS(Y+13,CHOICE,""))
+15 IF $GET(POLMEMBS("SELF"))=CHOICE
Begin DoDot:1
+16 WRITE !,"THIS IS THE POLICY HOLDER. IF YOU DELETE THE POLICY HOLDER"
+17 WRITE !,"THE PRIVATE INSURANCE ELIGIBILITIES OF ALL MEMBERS OF THIS"
+18 WRITE !,"POLICY WILL BE DELETED INCLUDING THE POLICY HOLDER"
+19 WRITE !,"DO YOU REALLY WANT TO DO THIS?"
+20 KILL DIR
+21 SET DIR("B")="N"
+22 SET DIR(0)="Y"
+23 DO ^DIR
+24 SET DELALL=Y=1
End DoDot:1
IF 'Y
QUIT
+25 ;DELETE ALL MEMBERS INCLUDING POLICY HOLDER
+26 IF $GET(DELALL)
DO DELALL(.POLMEMBS,POLHPTR,.CANCELED)
QUIT
+27 ;DELETE ONE MEMBER
+28 ;
+29 DO DELETE(CHOICE,RECORD,.CANCELED)
+30 QUIT
DELALL(POLMEMBS,POLHPTR,CANCELED) ;EP - DELETE ALL POLICY MEMBERS INCLUDING POLICY HOLDER
+1 IF '$DATA(POLMEMBS)
QUIT
+2 NEW ITEM
+3 SET ITEM=""
+4 FOR
SET ITEM=$ORDER(POLMEMBS(ITEM))
IF 'ITEM
QUIT
Begin DoDot:1
+5 SET CHOICE=$ORDER(POLMEMBS(ITEM,""))
+6 SET RECORD=$ORDER(POLMEMBS(ITEM,CHOICE,""))
+7 DO DELETE(CHOICE,RECORD,.CANCELED)
End DoDot:1
IF $GET(CANCELED)
QUIT
+8 IF $GET(CANCELED)
QUIT
+9 ;
+10 ;SINCE WE ARE DELETING ALL MEMBERS INCLUDING THE HOLDER,
+11 ;DELETE THE POLICY HOLDER ENTRY AS WELL
+12 KILL DIE,DIC,DIK,DA,DIR
+13 SET DA=$GET(POLHPTR)
+14 SET DIK="^AUPN3PPH("
+15 DO ^DIK
+16 KILL POLMEMBS
+17 QUIT
DELETE(CHOICE,RECORD,CANCELED) ;EP - DELETE MEMBER
+1 IF '$GET(CHOICE)!('$GET(RECORD))
QUIT
+2 ;CHECK IF THERE ARE BILLS OR CLAIMS OUTSTANDING FOR THIS MEMBER
+3 SET IN3PB=$$USED^AGUTILS(CHOICE,"",8,RECORD)
+4 IF $LENGTH(IN3PB)
Begin DoDot:1
+5 WRITE !?15,"WARNING: This member has outstanding claims and/or bills!!!"
+6 WRITE !?24,"Deleting this member may cause data integrity problems"
+7 WRITE !?24,"in the Third Party Billing package!!"
+8 KILL DIR,DIE,DA,DIC,DR
+9 SET DIR(0)="Y"
+10 SET DIR("B")="N"
+11 SET DIR("A")="Continue to delete?"
+12 DO ^DIR
+13 SET CANCELED=Y=0
End DoDot:1
IF $GET(CANCELED)
QUIT
+14 KILL DIE,DIC,DIK,DA,DIR
+15 SET DA(1)=$GET(CHOICE)
+16 SET DIK="^AUPNPRVT("_DA(1)_",11,"
+17 SET DA=$GET(RECORD)
+18 DO ^DIK
+19 KILL DIE,DIC,DIK,DA,DIR
+20 ;IF THIS IS THE LAST PRIVATE INSURER STORED FOR THIS PATIENT THEN
+21 ;CLEAN UP TOP RECORD
+22 IF '$ORDER(^AUPNPRVT(CHOICE,11,0))
Begin DoDot:1
+23 KILL DIE,DIC,DIK,DA,DIR
+24 SET DA=$GET(CHOICE)
+25 SET DIK="^AUPNPRVT("
+26 DO ^DIK
+27 KILL DIE,DIC,DIK,DA,DIR
End DoDot:1
+28 QUIT
