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

IBCNSJ51.m

Go to the documentation of this file. 
  1. IBCNSJ51 ;ALB/TMP - INSURANCE PLAN MAINTENANCE ACTION PROCESSING  (continued); 15-AUG-95
  1.  ;;2.0;INTEGRATED BILLING;**43,631,664**;21-MAR-94;Build 29
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. EDCOV ; Add/edit limitations of coverage for a plan in IBCPOL
  1.  ;/IB*2.0*631/vd - Added the variables IBALL and OPTN (for US4555)
  1.  N DIC,DIE,DR,DONE,DONE1,IB1,IBALL,IBCOV,IBCNT,IBEDT,IBEDT1,IBOK,IBOUT,IBQUIT,IBTYP,OPTN,Z
  1.  G:'$G(IBCPOL) EDCOVEX
  1.  D FULL^VALM1
  1.  ;
  1.  S (DONE,OPTN)=0
  1.  S DONE=0
  1.  F  D  Q:DONE!(OPTN<0)  ; Effective date selection
  1.  .K DIR
  1.  .W !
  1.  .S DIR(0)="DO",DIR("A")="Select EFFECTIVE DATE",DIR("?")="^D COVDTH^IBCNSJ51" S:$D(IBEDT) DIR("B")=$$DAT1^IBOUTL(IBEDT)
  1.  .D ^DIR W:$D(Y(0)) "  ",Y(0) K DIR
  1.  .I $D(DIRUT) S DONE=1 Q
  1.  .;IB*2.0*664/TAZ - Initialize IBEDT1 to equal the selected Effective Date.
  1.  .S (IBEDT,IBEDT1)=Y\1,IBCNT=0
  1.  .K IBTYP
  1.  .;IB*2.0*664/TAZ - Check for imprecise date and prompt for a precise date for filing.
  1.  .I '$$PRECISE(DT,IBEDT) D  I DONE S DONE=0 Q   ; Reset DONE to not Quit out totally on BAD DATES.
  1.  .. I $$EXISTS(IBCPOL,IBEDT) D  Q   ; Check to see if there are any categories for the selected policy and imprecise date.
  1.  ... S IBALL="ALL",DA=""
  1.  ... K IBTYP S IBTYP=0
  1.  ... F  S IBTYP=$O(^IBE(355.31,IBTYP)) Q:'IBTYP  D
  1.  .... I $D(^IBA(355.32,"APCD",+IBCPOL,IBTYP,-IBEDT)) S IBTYP(IBTYP)=""
  1.  ... D DELETE(IBALL,IBEDT,DA)  ; Check if the existing categories should be deleted for the imprecise date.
  1.  ... S DONE=1
  1.  ... Q
  1.  ..;
  1.  .. S DIR("A")="Enter a new precise EFFECTIVE DATE"
  1.  .. S DIR("A",1)="You have entered an imprecise date.  You must enter a precise date to"
  1.  .. S DIR("A",2)="edit/add a Coverage Limitation."
  1.  .. S DIR("A",4)=""
  1.  .. S DIR(0)="D^::EX"
  1.  .. D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S DONE=1 Q
  1.  .. S (IBEDT,IBEDT1)=Y\1
  1.  .;
  1.  .S DONE1=0
  1.  .F  D  Q:DONE1!(OPTN<0)  ; Coverage category type selection
  1.  ..K DIR
  1.  ..W !
  1.  ..S DIR(0)="F"_$S(IBCNT:"O",1:"")_"^1:30",DIR("A")="Select "_$S(IBCNT:"another ",1:"")_"coverage category -OR- "_$S(IBCNT:"Press ENTER if selection is complete",1:"'ALL' to select all coverage categories")
  1.  ..S DIR("?")="^D COVTYPH^IBCNSJ51"
  1.  ..D ^DIR K DIR
  1.  ..I $D(DUOUT)!$D(DTOUT) S DONE1=1 Q
  1.  ..;
  1.  ..S IBALL=Y        ;/IB*2.0*631 - vd - Preserving the 'Y' variable in the IBALL variable so it won't get stepped on.
  1.  ..;/IB*2.0*631 - vd - Added some new prompting and deleting capabilities below.
  1.  ..I IBALL="ALL" D
  1.  ...S OPTN="E",IBTYP=0   ; Default OPTN to EDIT...if no categories exist for date...we just want to ADD. No need to ask 'Edit or Delete' question.
  1.  ...I $$EXISTS(IBCPOL,IBEDT) S OPTN=""    ; Check to see if there are existing categories for the date entered.
  1.  ...I OPTN="" S OPTN=$$ASK(0) Q:(OPTN<0)
  1.  ..I IBALL'="" D  Q:$TR(IBCNT,"al","AL")'="ALL"
  1.  ...I 'IBCNT,IBALL="ALL" D  Q
  1.  ....S IBCNT="ALL",IBTYP=0
  1.  ....F  S IBTYP=$O(^IBE(355.31,IBTYP)) Q:'IBTYP  D
  1.  .....I OPTN="D" D  Q
  1.  ......I $D(^IBA(355.32,"APCD",+IBCPOL,IBTYP,-IBEDT)) S IBTYP(IBTYP)=""
  1.  .....I $$WARN1(IBTYP) S IBTYP(IBTYP)=""
  1.  ...S DIC="^IBE(355.31,",DIC(0)="EMQ",X=IBALL D ^DIC
  1.  ...I Y<0 Q:'$$QUIT()  S (DONE,DONE1)=1,IBCNT="" K IBTYP Q
  1.  ...I $D(IBTYP(+Y)) W !,"This category already selected." Q
  1.  ...S IBTYP=+Y I $$WARN1(IBTYP) S IBTYP(IBTYP)="",IBCNT=IBCNT+1
  1.  ..;
  1.  ..I $O(IBTYP(""))="" S (DONE,DONE1)=1 Q
  1.  ..;
  1.  ..I IBALL="ALL",OPTN="D" D DELETE(IBALL,IBEDT) Q
  1.  ..;
  1.  ..S IBTYP=""
  1.  ..F  S IBTYP=$O(IBTYP(IBTYP)) Q:IBTYP=""  D  Q:DONE1!(OPTN<0)
  1.  ...K ^TMP($J,"IBCAT")
  1.  ...;IB*2.0*664/TAZ - Display the proper date to be filed.
  1.  ...W !!,"Effective Date: ",$$DAT1^IBOUTL(IBEDT1),"   Coverage Category: ",$P($G(^IBE(355.31,+IBTYP,0)),U)
  1.  ...S OPTN="",DA=$O(^IBA(355.32,"APCD",+IBCPOL,IBTYP,-IBEDT,""))
  1.  ...;/IB*2.0*631 - vd - Added some new prompting and deleting capabilities below, for US4555.
  1.  ...I 'DA S OPTN="E"
  1.  ...I IBALL'="ALL",OPTN="" S OPTN=$$ASK(1) Q:(OPTN<0)  I OPTN="D" D  Q
  1.  ....D DELETE(IBALL,IBEDT,DA)
  1.  ...I DA'="" D SAVE^IBCNSJ52(DA) W !,"Editing existing record.",!
  1.  ...I DA="" D  Q:'DA  ;Add a new record
  1.  ....W ! S DIR(0)="Y",DIR("A",1)="A new record will be added for this EFFECTIVE DATE/coverage category."
  1.  ....S DIR("A")="Is this OK",DIR("B")="YES" D ^DIR K DIR
  1.  ....I Y'=1 S:$$QUIT() (DONE,DONE1)=1 Q
  1.  ....K DO,DD
  1.  ....;IB*2.0*664/TAZ - File the proper (precise) date
  1.  ....S DIC="^IBA(355.32,",DIC(0)="L",X=IBCPOL,DIC("DR")=".02////"_IBTYP_";.03////"_IBEDT1_";.04////1" D FILE^DICN
  1.  ....S DA=$S(Y>0:+Y,1:0)
  1.  ....W:DA !,"New record added.",!
  1.  ...;
  1.  ...S IBCOV=DA
  1.  ...;
  1.  ...L +^IBA(355.32,IBCOV):5 I '$T D LOCKED^IBTRCD1 Q
  1.  ...S DIE="^IBA(355.32,",DR=".04;S Y=$S(X'>1:"""",1:2);2"
  1.  ...D ^DIE S IBOUT=$D(Y)
  1.  ...I $P($G(^IBA(355.32,IBCOV,0)),U,4)'>1,$O(^(2,0)) S Z=0 F  S Z=$O(^IBA(355.32,IBCOV,2,Z)) Q:'Z  S DIK="^IBA(355.32,"_IBCOV_",2,",DA(1)=IBCOV,DA=Z D ^DIK ;Delete comments
  1.  ...I $$DIFFLIM^IBCNSJ52(IBCOV) S DIE="^IBA(355.32,",DA=IBCOV,DR="1.03///NOW;1.04////^S X=DUZ" D ^DIE ;Update user who edited entry
  1.  ...L -^IBA(355.32,IBCOV)
  1.  ...;
  1.  ...I IBOUT,$$QUIT() S (DONE,DONE1)=1
  1.  ..K IBTYP S IBCNT=0
  1.  ;
  1. EDCOVEX S VALMBCK="R"
  1.  K ^TMP($J,"IBCOV")
  1.  Q
  1.  ;
  1. QUIT() ; Quit coverage limitation loop
  1.  N DIR,Y
  1.  S DIR(0)="Y",DIR("A")="Do you want to exit this function now",DIR("B")="YES" D ^DIR
  1.  Q Y
  1.  ;
  1. COVDTH ; Help text for selecting effective date on coverage add/edit
  1.  N Z,Z0,ZX,CT
  1.  D HELP^%DTC
  1.  I $O(^IBA(355.32,"APCD",IBCPOL,""))="" W !!,"No current dates on file for this plan." Q
  1.  W !!,"Current dates on file for this plan:"
  1.  S Z="" F  S Z=$O(^IBA(355.32,"APCD",IBCPOL,Z)) Q:'Z  S Z0="" F  S Z0=$O(^IBA(355.32,"APCD",IBCPOL,Z,Z0)) Q:'Z0  S ZX(Z0,Z)=""
  1.  S Z="" F  S Z=$O(ZX(Z)) Q:'Z  W !,?3,$$DAT1^IBOUTL(-Z)," -"  S Z0="",CT=0 F  S Z0=$O(ZX(Z,Z0)) Q:'Z0!(CT>3)  S CT=CT+1 W "  ",$P($G(^IBE(355.31,Z0,0)),U) W:CT=4&($O(ZX(Z,Z0))'="") " (and more)"
  1.  Q
  1.  ;
  1. COVTYPH ; Help text for selecting coverage category on coverage add/edit
  1.  N DIC
  1.  W !!,"Enter a coverage category to add/edit coverage limitations for.",!
  1.  S DIC="^IBE(355.31,",DIC(0)="M",X="?" D ^DIC
  1.  I '$G(IBCNT) W !,"Enter ALL to select all coverage categories."
  1.  W !,"You may enter multiple coverage categories by entering them one at a time.",!,"After you have selected all needed categories, press ENTER at this prompt to",!,"continue."
  1.  Q
  1.  ;
  1. WARN1(IBTYP) ; Warning if adding/editing an earlier effective date than latest one on file
  1.  N IB1,Y
  1.  S IB1=$O(^IBA(355.32,"APCD",+IBCPOL,IBTYP,-9999999)),Y=1
  1.  I IB1'="",IB1<-IBEDT D
  1.  .W !
  1.  .S DIR(0)="Y",DIR("A",1)="An effective date later than the one you selected",DIR("A",2)="already exists for "_$P($G(^IBE(355.31,IBTYP,0)),U)_"."
  1.  .S DIR("A")=" Are you sure you want to "_$S($D(^IBA(355.32,"APCD",+IBCPOL,IBTYP,-IBEDT)):"edit",1:"add")_" this earlier date for the category",DIR("B")="NO"
  1.  .D ^DIR K DIR
  1.  .W !
  1.  Q (Y=1)
  1.  ;
  1.  ;/IB*2.0*631/vd - This section added (for US4555)
  1. ASK(ALLENT) ; Does the user want to Edit or Delete the selected category(ies)?
  1.  ; ALLENT - if set to 1, the user has selected a single entry
  1.  ; - if set to anything other than 1, the user has selected 'all' entries.
  1.  ;
  1.  N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1.  S DIR(0)="SA^E:Edit;D:Delete",DIR("B")="E"
  1.  S DIR("A")="Do you want to Edit or Delete "_$S(ALLENT=1:"this entry",1:"entries")_"? "
  1.  S DIR("?")="If you wish to EDIT "_$S(ALLENT=1:"this entry",1:"entries")_" enter 'E'dit. To DELETE "_$S(ALLENT=1:"this entry",1:"entries")_" enter 'D'elete."
  1.  W ! D ^DIR
  1.  Q $S("^D^E^"[(U_Y_U):Y,1:-1)
  1.  ;
  1.  ;/IB*2.0*631/vd - This section added (for US4555)
  1. DELETE(OPTALL,DDATE,IBREC) ; Delete specified Categories
  1.  ; INPUT:   OPTALL - This can be either a specified coverage category or 'ALL'
  1.  ;                 DDATE  - This is the selected effective date
  1.  ;                 IBREC  - This is the record to be deleted for the selected coverage category, or it is NULL for 'ALL'
  1.  N DELOP,IBREF,IBTY,TMP
  1.  I OPTALL="ALL" D  Q
  1.  . ;
  1.  . W !!,"The effective date of ",$$DAT1^IBOUTL(IBEDT)," will be deleted for the following coverage"
  1.  . W !,"categories:"
  1.  . S IBTY="" F  S IBTY=$O(IBTYP(IBTY)) Q:IBTY=""  D
  1.  . . W !?5,$$GET1^DIQ(355.31,IBTY_",",.01)   ; Display a Coverage Category.
  1.  . . S IBREF=$O(^IBA(355.32,"APCD",+IBCPOL,IBTY,(-1*DDATE),""))
  1.  . . S TMP(+IBCPOL,IBTY)=IBREF
  1.  . ;
  1.  . I '$D(TMP) D  Q   ; Only display if no Coverage Categories were found.
  1.  . . W ! S DIR("A",1)="No Coverage Categories found for requested effective date."
  1.  . . S DIR(0)="FAO",DIR("A")="Press RETURN to continue..." D ^DIR K DIR
  1.  . ;
  1.  . S DELOP=$$DELASK(DDATE) Q:'DELOP
  1.  . ; Loop thru the TMP local global for IBCPOL and DELETE the list of related COVERAGE CATEGORIES.
  1.  . S IBTY="" F  S IBTY=$O(TMP(IBCPOL,IBTY)) Q:IBTY=""  D
  1.  . . S IBREF=TMP(IBCPOL,IBTY)
  1.  . . D DELETIT(IBREF)
  1.  . . D DELMSG(DDATE,IBTY)
  1.  . K TMP
  1.  ;
  1.  S DELOP=$$DELASK(DDATE) Q:'DELOP
  1.  D DELETIT(IBREC)       ; Delete the selected coverage category
  1.  D DELMSG(DDATE,IBTYP)  ; Report to user that category was deleted
  1.  Q
  1.  ;
  1.  ;/IB*2.0*631/vd - This section added (for US4555)
  1. DELASK(DDATE) ; Prompt the user for DELETE question.
  1.  N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1.  W ! S DIR(0)="Y",DIR("A")="Are you sure you want to delete the effective date of "_$$DAT1^IBOUTL(DDATE)
  1.  S DIR("B")="N" D ^DIR K DIR W !
  1.  Q Y
  1.  ;
  1.  ;/IB*2.0*631/vd - This section added (for US4555)
  1. DELMSG(DDATE,CAT) ; Display message that a Coverage Category has been deleted.
  1.  N CATNAM
  1.  S CATNAM=$$GET1^DIQ(355.31,CAT_",",.01)
  1.  W !,$$DAT1^IBOUTL(IBEDT)," for ",CATNAM," has been deleted."
  1.  Q
  1.  ;
  1.  ;/IB*2.0*631/vd - This section added (for US4555)
  1. DELETIT(DA) ; Delete a coverage category for a selected date.
  1.  ; DA - passed in IEN (was variable IBREC)
  1.  N DIDEL,DIK
  1.  S DIK="^IBA(355.32,",DIDEL=355.32 D ^DIK ;Delete coverage category record for the specific date.
  1.  K DIK
  1.  Q
  1.  ;
  1. PRECISE(X1,X2) ;Check to make sure the date entered is a precise date.
  1.  N %Y
  1.  D ^%DTC
  1.  Q %Y
  1.  ;
  1. EXISTS(IBCPOL,IBEDT) ; Check to see if there are any categories for the selected policy and date.
  1.  N EXISTS,IBTYP
  1.  S (EXISTS,IBTYP)=0
  1.  F  S IBTYP=$O(^IBE(355.31,IBTYP)) Q:'IBTYP  D  Q:+EXISTS
  1.  .I $D(^IBA(355.32,"APCD",+IBCPOL,IBTYP,-IBEDT)) S EXISTS=1   ; Found a category with this date...so able to ask 'Edit or Delete' question.
  1.  Q EXISTS