Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGEDPRVP

AGEDPRVP.m

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