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

AGEDPRVI.m

Go to the documentation of this file. 
  1. AGEDPRVI ;IHS/ASDS/TPF - EDIT PRIVATE INSURANCE ELIGIBLE FIELDS ;    
  1.  ;;7.1;PATIENT REGISTRATION;**1,2,8**;AUG 25, 2005
  1.  ;ALL CALLS TO THIS ROUTINE WILL BE FOR EEDITING POLICY HOLDER FIELDS
  1.  ;
  1.  Q
  1. EDITPOLM(POLMEMBS,CHOICES) ;EP - EDIT POLICY MEMBER INSURANCE INFORMATION
  1. EDITPOL2 ;EP -
  1.  N PIECE,ITEM,RECORD,INSPTR
  1.  N AGOLDDT,AGNEWDT
  1.  F PIECE=1:1 S ITEM=$P(CHOICES,",",PIECE) Q:ITEM=""  D
  1.  .S POLMPTR=$O(POLMEMBS(ITEM,""))
  1.  .S INSPTR=$O(POLMEMBS(ITEM,POLMPTR,""))
  1.  .W !!,"Policy Member: ",$P($G(^DPT(POLMPTR,0)),U)
  1.  .K DIC,DA,DIR,DIE,DIR,DR
  1.  .;S DR="05R~Relationship to Insured..: ;.06Starting Date.. : ;.07Expiration Date...:  ;.12Person Code...: ;21Member Number:"  ;AG*7.1*2 ALPHA TESTING
  1.  .S DR="05R~Relationship to Insured..: ;.06R~Starting Date.. : ;.07Expiration Date...:  ;.12Person Code...: ;21Member Number:"
  1.  .S AGOLDDT=$$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I","AGDATA","AGERR")
  1.  .S DA=INSPTR
  1.  .S DA(1)=POLMPTR
  1.  .S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  .D ^DIE
  1.  .;AG*7.1*2 FOUND IN TESTING. CHANGE WILL BE MADE TO DD FOR AUPNPRVT
  1.  .I $$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I"),($$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.06,"I")>$$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I")) D  G EDITPOL2
  1.  ..W !!,"STARTING DATE CANNOT BE AFTER TERMINATION DATE!" H 2
  1.  .S AGNEWDT=$$GET1^DIQ(9000006.11,INSPTR_","_POLMPTR_",",.07,"I","AGDATA","AGERR")
  1.  .K DIC,DA,DIR,DIE,DR
  1.  .;AG*7.1*2 REQUESTED DURING TESTING ALSO IM20317
  1.  .Q:AGOLDDT=AGNEWDT  ;NO UPDATE IF THERE WAS NO CHANGE MADE
  1.  .Q:$G(POLMEMBS("SELF"))=""  ;IF NO SELF THEN POLICY HOLDER IS NOT LISTED IN THE MEMBER SECTION
  1.  .I ($G(POLMPTR)=$G(POLMEMBS("SELF"))) D
  1.  ..D UPDTERM^AGEDPRVP(AGELP("PH"),AGNEWDT,AGOLDDT)
  1.  ..K DIC,DA,DIR,DIE,DR
  1.  ..I AGNEWDT="" S DR=".18///@"
  1.  ..E  S DR=".18///^S X=AGNEWDT"
  1.  ..S DIE="^AUPN3PPH("
  1.  ..S DA=AGELP("PH")
  1.  ..D ^DIE
  1.  ..K DIC,DA,DIR,DIE,DR
  1.  Q
  1. ADDOPT(PATPTR,INSPTR,POLHPTR,POLMEMBS) ;EP - ADD MEMBER FORM PRVT PAGE A
  1.  K DIE,DIC,DR,DIR,DA
  1.  S DR=".12   Person Code..: ;.14   Primary Care Provider...: ;21   Member Number..: ;.15  Card Copy Obtained (Y/N)?..: "
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  K DIE,DIC,DR,DIR,DA
  1.  I $P($G(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,15)="Y" D
  1.  .K DIE,DIC,DR,DIR,DA
  1.  .S DIE("NO^")=""
  1.  .S DR=".16R~ Date CC Obtained..: "
  1.  .S DA=INSPTR
  1.  .S DA(1)=PATPTR
  1.  .S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  .D ^DIE
  1.  .K DIE,DIC,DR,DIR,DA
  1.  I $P($G(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,15)="N" D
  1.  .K DIE,DIC,DR,DIR,DA
  1.  .S DR=".16////@"
  1.  .S DA=INSPTR
  1.  .S DA(1)=PATPTR
  1.  .S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  .D ^DIE
  1. REL ;EP - EDIT RELATIONSHIP TO INSURER
  1.  K DIE,DIC,DR,DIR,DA
  1.  S DR=".05R~ Relationship to Insured..: "
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  I $D(POLMEMBS("SELF")),($P($G(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,5)=25) D  G REL
  1.  .W !!,"THERE IS ALREADY A POLICY HOLDER FOR THIS POLICY!!"
  1.  .S $P(^AUPNPRVT(PATPTR,11,INSPTR,0),U,5)=""
  1.  K DIE,DIC,DR,DIR,DA
  1.  ;STUFF ADDITIONAL ITEMS THAT WE CAN
  1.  D EDITPOLN(PATPTR,INSPTR,POLHPTR)
  1.  D EDITCON(PATPTR,INSPTR,POLHPTR)
  1.  D EDITBDT(PATPTR,INSPTR,POLHPTR,"S")
  1.  D EDITEDT(PATPTR,INSPTR,POLHPTR,"S")
  1.  D EDITPH(PATPTR,INSPTR,POLHPTR)
  1.  D EDITNAME(PATPTR,INSPTR,POLHPTR,"S")
  1.  Q
  1. EDITPCD(PATPTR,INSPTR) ;EP - EDIT PERSON CODE 
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  S DR=".12   Person Code...: "
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  Q
  1. EDITMNUM(PATPTR,INSPTR) ;EP - EDIT MEMBER NUMBER
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  S DR="21   Member Number..: "
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  Q
  1. EDITPOLN(PATPTR,INSPTR,POLHPTR) ;EP - STUFF POLICY NUMBER
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  I $G(POLHPTR) S DR=".02////"_$P($G(^AUPN3PPH(POLHPTR,0)),U,4)
  1.  E  S DR=.02
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  Q
  1. EDITCON(PATPTR,INSPTR,POLHPTR) ;EP - STUFF COVERAGE PTR
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  I $G(POLHPTR) S DR=".03////"_$P($G(^AUPN3PPH(POLHPTR,0)),U,5)
  1.  E  S DR=.03
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  Q
  1. EDITBDT(PATPTR,INSPTR,POLHPTR,TYPE) ;EP - STUFF ELIG BEGIN DATE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  I $G(POLHPTR),($G(TYPE)="S") S DR=".06////"_$P($G(^AUPN3PPH(POLHPTR,0)),U,17)
  1.  E  S DR=".06 Sarting Date.. : "
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  Q
  1. EDITEDT(PATPTR,INSPTR,POLHPTR,TYPE) ;EP - STUFF ELIG END DATE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  I $G(POLHPTR),($G(TYPE)="S") S DR=".07////"_$P($G(^AUPN3PPH(POLHPTR,0)),U,18)
  1.  E  S DR=".07 Expiration Date...: "
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  Q
  1. EDITPH(PATPTR,INSPTR,POLHPTR) ;EP - STUFF POLICY HOLDER PTR
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  I $G(POLHPTR) S DR=".08////"_POLHPTR
  1.  E  S DR=.08
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  Q
  1. EDITNAME(PATPTR,INSPTR,POLHPTR,TYPE) ;EP - STUFF POLICY HOLDER NAME
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  I $G(POLHPTR),($G(TYPE)="S") S DR=".04////"_$P($G(^AUPN3PPH(POLHPTR,0)),U)
  1.  E  I $G(TYPE)="E" S DR=".04Name as Stated on Policy..: //"
  1.  E  S DR=".04"
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  Q
  1. EDITREL(PATPTR,INSPTR,SAME) ;EP - EDIT/STUFF RELATIONSHIP PTR
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  ;CHECK HERE FOR SAME
  1.  I $G(SAME) S DR=".05///SELF"
  1.  E  S DR=".05R~Relationship to Insured..: "
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  Q
  1. EDITPCP(PATPTR,INSPTR,CALLER) ;EP - EDIT PRIMARY CARE PROVIDER
  1.  K DR,DIE,DIC,DA,DIR,DR
  1.  I $G(CALLER)="SCREEN" W !!
  1.  S DA(1)=PATPTR
  1.  S DA=INSPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  S DR=".14[7] PCP: "                                                                   ;AG*7.1*8
  1.  D ^DIE
  1.  K DR,DIE,DIC,DA,DIR,DR
  1.  Q
  1. EDITCC(PATPTR,INSPTR,CALLER) ;EP - EDIT CARD COPY ON FILE/ DATE RECEIVED
  1.  K DIE,DIC,DR,DA,DIR,DR
  1.  I $G(CALLER)="SCREEN" W !!
  1.  S DA(1)=PATPTR
  1.  S DA=INSPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  S DR=".15[13] Card Copy on file: "
  1.  D ^DIE
  1.  I $P($G(^AUPNPRVT(PATPTR,11,INSPTR,0)),U,15)[("Y") D EDITCCDT(PATPTR,INSPTR)
  1.  K DIE,DIC,DR,DA,DIR,DR
  1.  Q
  1. EDITCCDT(PATPTR,INSPTR) ;EP - EDIT CARD COPY DATE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  S DIE("NO^")=""
  1.  S DR=".16R~ Date CC obtained..:"
  1.  S DA=INSPTR
  1.  S DA(1)=PATPTR
  1.  S DIE="^AUPNPRVT("_DA(1)_",11,"
  1.  D ^DIE
  1.  K DIC,DA,DIR,DIE,DIR,DR
  1.  Q