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

IBCEPA.m

Go to the documentation of this file. 
  1. IBCEPA ;ALB/WCJ - Provider ID functions - Care Units ;21-OCT-2005
  1.  ;;2.0;INTEGRATED BILLING;**320,348,377**;21-MAR-94;Build 23
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. EN ; -- main entry point for IBCE 2ND PRVID CARE UNIT MAINT
  1.  D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT")
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  K VALMHDR
  1.  S VALMHDR(1)=" "
  1.  S VALMHDR(2)="Insurance Co: "_$S('$G(IBALL)&$G(IBINS):$P($G(^DIC(36,+IBINS,0)),U),1:"ALL")
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  N DIR,Y
  1.  I '$G(IBINS) D  I +Y<0 S VALMQUIT=1 Q
  1.  . S DIR(0)="PA^DIC(36,:AEMQ",DIR("A")="Select INSURANCE CO: ",DIR("?")="Select an INSURANCE CO to display its care units"
  1.  . D ^DIR K DIR
  1.  . I $D(DTOUT)!$D(DUOUT) S Y=-2 Q
  1.  . I Y>0 S IBINS=+Y Q
  1.  ;
  1.  D BLD
  1.  Q
  1.  ;
  1. BLD ;
  1.  D CLEAN^VALM10
  1.  K ^TMP("IBPRV_CU",$J)
  1.  N TAR,MSG,I,D0,IBCT,Z,DIV,SCREEN
  1.  ;
  1.  S VALMBG=1
  1.  ;
  1.  ; Get all care units for this insurance company that have a division
  1.  ; If there is no division, then it is part of the other care units code (IBCEP4)
  1.  ; 
  1.  S SCREEN="I $P(^(0),U,4)'="""",$P(^(0),U,3)=IBINS"
  1.  D LIST^DIC(355.95,,"@;.01;.02;.04",,,,,,SCREEN,,"TAR")
  1.  ;
  1.  I '+TAR("DILIST",0) D
  1.  . D SET^VALM10(1,"No CARE UNITs found for this Insurance Company")
  1.  ;
  1.  I +TAR("DILIST",0) D
  1.  . S IBCT=0
  1.  . F VALMCNT=1:1:+TAR("DILIST",0) D
  1.  .. S ^TMP("IBPRV_CU",$J,"SORT",TAR("DILIST","ID",VALMCNT,.04),TAR("DILIST",2,VALMCNT))=VALMCNT
  1.  . S DIV="" F  S DIV=$O(^TMP("IBPRV_CU",$J,"SORT",DIV)) Q:DIV=""  D
  1.  .. S Z="Division: "_DIV
  1.  .. S IBCT=IBCT+1
  1.  .. D SET^VALM10(IBCT,Z)
  1.  .. S D0=0 F  S D0=$O(^TMP("IBPRV_CU",$J,"SORT",DIV,D0)) Q:'D0  D
  1.  ... S IN=^TMP("IBPRV_CU",$J,"SORT",DIV,D0)
  1.  ... S Z=$J("",2)
  1.  ... S Z=Z_$E(IN_"    ",1,4)_$E(TAR("DILIST","ID",IN,.01),1,36)
  1.  ... S Z=Z_$J("",40-$L(Z))
  1.  ... S Z=Z_$E(TAR("DILIST","ID",IN,.02),1,38)
  1.  ... S IBCT=IBCT+1
  1.  ... D SET^VALM10(IBCT,Z)
  1.  ;
  1.  ; correct the VALMCNT variable - number of lines in the list (not entries)
  1.  S VALMCNT=+$O(@VALMAR@(""),-1)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  D CLEAN^VALM10
  1.  K ^TMP("IBPRV_CU",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. NEW ; Add care unit
  1.  ; Assumes IBINS is defined as ins co ien (file 36)
  1.  ; IB = 0 or null if called from list manager, 1 if not
  1.  N DIC,DIR,X,Y,Z,D,DA,DR,DIE,DO,DD,DLAYGO,IB95,IBADD,IBOK,IBDIV,MAIN,IBDIVNM
  1.  ;
  1.  D FULL^VALM1
  1.  ; Add an entry - either new care unit/ins co or a combination for
  1.  ; existing care unit/ins co
  1.  ;
  1.  S MAIN=$$MAIN^IBCEP2B()
  1.  S MAIN=$$EXTERNAL^DILFD(355.92,.05,"",MAIN)
  1.  S DIC=40.8,DIC("A")="Enter the Division for this Care Unit: ",DIC("B")=MAIN,DIC(0)="AEMQ"
  1.  S D="B^C"
  1.  D MIX^DIC1
  1.  I Y'>0 G NEWQ
  1.  S IBDIV=+Y
  1.  S IBDIVNM=$$EXTERNAL^DILFD(355.92,.05,"",IBDIV)
  1.  ;
  1.  N SCREEN,TAR,MESS,I
  1.  S SCREEN="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)"
  1.  D LIST^DIC(355.95,,.01,,,,,,SCREEN,,"TAR")
  1.  ;
  1. ACU K DIR
  1.  S I=0
  1.  I $G(TAR("DILIST",0)) D 
  1.  . S DIR("?",1)="Current Entries are:"
  1.  . F I=2:1 Q:'$D(TAR("DILIST",1,I-1))  S DIR("?",I)="     "_TAR("DILIST",1,I-1)
  1.  . S DIR("?",I)=" "
  1.  ;
  1.  S DIR("?",I+1)="You may enter the name of a new Care Unit for this Insurance Company."
  1.  S DIR("?",I+2)="You can then define a Billing Provider Secondary ID - Billing Screen 3 - for"
  1.  S DIR("?")="this Care Unit and Insurance Company using the Insurance Company Editor."
  1.  S DIR("A")="Enter the Care Unit name"
  1.  S DIR(0)="FO^1:30"
  1.  D ^DIR
  1.  I X=""!$G(DUOUT)!$G(DTOUT)!$G(DIROUT) G NEWQ
  1.  S CAREUNIT=X
  1.  ; 
  1.  ; At this point, we have X and it'a not a ? or ^
  1.  ;
  1.  K DIC
  1.  S DIC="^IBA(355.95,",DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="EX"
  1.  D ^DIC
  1.  ;
  1.  ; Check if we have an exisitng entry and if so, get out of Dodge (This option was for new care units)
  1.  I Y>0 D  G ACU
  1.  . D DISPMESS("This action is for adding new entries, not editing existing entries.")
  1.  ;
  1.  ; New entry , validate field
  1.  N TAR2
  1.  D FIELD^DID(355.95,.01,"N","INPUT TRANSFORM","TAR2")
  1.  S X=CAREUNIT
  1.  X TAR2("INPUT TRANSFORM")
  1.  I '$D(X) D  G ACU  ; Failed input transform
  1.  . D DISPMESS("Invalid Format.")
  1.  ;
  1.  K DIR
  1.  S DIR("A")="Are you adding '"_X_"' as a new Care Unit for '"_IBDIVNM_"'"
  1.  S DIR("B")="N"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  I Y=0 G ACU
  1.  I Y["^" G NEWQ
  1.  ;
  1.  ; If it got this far, we have an exact match or a new entry.   
  1.  S X=CAREUNIT
  1.  S DIC="^IBA(355.95,",DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="XL",DLAYGO=355.95
  1.  S DIC("DR")=".03////"_+$G(IBINS)_";.04////"_$G(IBDIV)
  1.  D ^DIC
  1.  I Y>0 D
  1.  . S DA=+Y,DIE="^IBA(355.95,"
  1.  . S DR=".02Enter the Care Unit Description"
  1.  . D ^DIE
  1.  D BLD
  1.  ;
  1. NEWQ S VALMBCK="R"
  1.  Q
  1.  ;
  1. CHANGE ; Edit care unit
  1.  ; Assumes IBINS is defined as ins co ien (file 36)
  1.  ;
  1.  D FULL^VALM1
  1.  ;
  1.  N X,Y,Z,D,DA,DD,DIC,DIK,DIR,IBDIV,CAREUNIT,SCREEN,TAR,DIVISION,I
  1.  ;
  1.  S SCREEN="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)]"""""
  1.  D LIST^DIC(355.95,,".01;.04",,,,,,SCREEN,,"TAR")
  1.  ;
  1.  I '+$G(TAR("DILIST",0)) D  G CHANGEQ
  1.  .D DISPMESS("No Care Units Defined for this insurance company.")
  1.  ;
  1.  ; Store all Divisons with at least one care unit in DIVISION array
  1.  F I=1:1 Q:'$D(TAR("DILIST","ID",I,.04))  D
  1.  . S DIVISION(TAR("DILIST","ID",I,.04))=""
  1.  ;
  1.  ; Only allow divisions that have care units to be selected
  1.  S DIC=40.8
  1.  S DIC("A")="Enter the Division for this Care Unit: "
  1.  S DIC(0)="AEMQ"
  1.  S DIC("S")="I $D(DIVISION($P(^(0),U)))"
  1.  S D="B^C"
  1.  D MIX^DIC1
  1.  I Y'>0 G CHANGEQ
  1.  S IBDIV=+Y
  1.  S DA=$$SEL($P(Y,U,2)) I 'DA G CHANGEQ
  1.  S DIE=355.95
  1.  S DR=".01Care Unit;.04Division;.02Description"
  1.  D ^DIE
  1.  ;
  1.  D BLD
  1.  ;
  1. CHANGEQ S VALMBCK="R"
  1.  Q
  1.  ;
  1. DEL ; Delete a Care Unit
  1.  ; Assumes IBINS is defined as ins co ien (file 36)
  1.  ; 
  1.  D FULL^VALM1
  1.  N X,Y,Z,D,DA,DD,DIC,DIK,DIR,IBDIV,CAREUNIT,SCREEN,TAR,DIVISION
  1.  ;
  1.  S SCREEN="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)]"""""
  1.  D LIST^DIC(355.95,,".01;.04",,,,,,SCREEN,,"TAR")
  1.  ;
  1.  I '+$G(TAR("DILIST",0)) D  G DELQ
  1.  .D DISPMESS("No Care Units Defined for this insurance company.")
  1.  ;
  1.  ; Store all Divisons with at least one care unit in DIVISION array
  1.  F I=1:1 Q:'$D(TAR("DILIST","ID",I,.04))  D
  1.  . S DIVISION(TAR("DILIST","ID",I,.04))=""
  1.  ;
  1.  ; Only allow divisions that have care units to be selected
  1.  S DIC=40.8
  1.  S DIC("A")="Enter the Division for this Care Unit: "
  1.  S DIC(0)="AEMQ"
  1.  S DIC("S")="I $D(DIVISION($P(^(0),U)))"
  1.  S D="B^C"
  1.  D MIX^DIC1
  1.  I Y'>0 G DELQ
  1.  S IBDIV=+Y
  1.  S CAREUNIT=$$SEL($P(Y,U,2)) I 'CAREUNIT G DELQ
  1.  ;
  1.  I $D(^IBA(355.92,"AC",+Y)) D  G DELQ
  1.  . S DIR(0)="EA"
  1.  . S DIR("A",1)="IDs that are assigned to the Care Unit in the Insurance Company Editor must be"
  1.  . S DIR("A",2)="deleted before deleting the Care Unit."
  1.  . S DIR("A")="Press return to continue "
  1.  . W ! D ^DIR K DIR
  1.  ;
  1.  S DIR("A")="OK to Delete: "
  1.  S DIR("B")="No"
  1.  S DIR(0)="YAO"
  1.  D ^DIR
  1.  I '$G(Y) G DELQ
  1.  K DIR
  1.  ;
  1.  S DA=CAREUNIT
  1.  S DIK="^IBA("_355.95_","
  1.  D ^DIK
  1.  ;
  1.  D BLD
  1.  ;
  1. DELQ S VALMBCK="R"
  1.  Q
  1.  ;
  1. DISPMESS(MESS) ;
  1.  N DIR,X,Y
  1.  S DIR(0)="EA",DIR("A",1)=MESS
  1.  S DIR("A")="PRESS ENTER to continue "
  1.  D ^DIR
  1.  Q
  1.  ;
  1. SEL(DIV) ; select care unit for a given division
  1.  ; DIV - name of division
  1.  ; returns ien of selected care unit, or 0 if nothing is selected
  1.  N DIR,I,IEN,MIN,MAX,X,Y
  1.  I $G(DIV)="" Q 0
  1.  S IEN=0
  1.  S I=$O(^TMP("IBPRV_CU",$J,"SORT",DIV,"")),MIN=$G(^TMP("IBPRV_CU",$J,"SORT",DIV,I))
  1.  S I=$O(^TMP("IBPRV_CU",$J,"SORT",DIV,""),-1),MAX=$G(^TMP("IBPRV_CU",$J,"SORT",DIV,I))
  1.  I MIN=MAX S IEN=I
  1.  I MIN'=MAX D
  1.  .S DIR("A")="Select CARE UNITS",DIR(0)="N^"_MIN_":"_MAX_":0" D ^DIR
  1.  .Q:$D(DTOUT)!$D(DUOUT)
  1.  .S I="" F  S I=$O(^TMP("IBPRV_CU",$J,"SORT",DIV,I)) Q:I=""!(IEN>0)  S:$G(^TMP("IBPRV_CU",$J,"SORT",DIV,I))=Y IEN=I
  1.  .Q
  1.  Q IEN