Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP4A.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP4A.m (modified) (4 diffs)

FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP4A.m

@@ -1 +1 @@
 IBCEP4A ;ALB/TMP - EDI UTILITIES for provider ID ;29-SEP-00
- ;;2.0;INTEGRATED BILLING;**137,232,280,349,377**;21-MAR-94;Build 23
+ ;;2.0;INTEGRATED BILLING;**137,232,280,349**;21-MAR-94;Build 46
  ;;Per VHA Directive 2004-038, this routine should not be modified.
  ;
@@ -23 +23 @@
  ; IB = 0 or null if called from list manager, 1 if not
  N DIC,DIK,DIR,X,Y,Z,DA,DR,DIE,DO,DD,DLAYGO,IB95,IBOK,IBZ,IB0,IBEDIT,IBCK,IBDA,IBCHG,IBDELETE,Z100,DTOUT,DUOUT
- I '$G(IB) D FULL^VALM1 S Y=$$SEL()
- I $G(IB) S DIC("A")="CARE UNIT NAME: ",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,3)=+$G(IBINS)",DIC="^IBA(355.95," W ! D ^DIC K DIC
+ I '$G(IB) D FULL^VALM1
+ S DIC("A")="CARE UNIT NAME: ",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,3)=+$G(IBINS)",DIC="^IBA(355.95," W ! D ^DIC K DIC
  I Y'>0 G CHGQ
  S IB95("IBCU")=+Y,IBDELETE=0,IBDELETE(0)=$G(^IBA(355.95,0)),IBDELETE(1)=$G(^(1))
@@ -30 +30 @@
  W ! S DIR("A")="CARE UNIT NAME: ",DIR("B")=$P($G(^IBA(355.95,+IB95("IBCU"),0)),U),DIR(0)="355.95,.01AO",DIR("S")="I $P(^(0),U,3)=IBINS" D ^DIR K DIR
  I $D(DTOUT)!$D(DUOUT) G CHGQ
- I X="@" S DIR(0)="EA",DIR("A")="NOTHING DELETED - PRESS ENTER TO CONTINUE" D ^DIR K DIR G CHGQ
+ ;
+ ; Care unit name was deleted
+ I X="@" D  G CHGQ
+ . S DIR("A",1)="THIS WILL DELETE THE CARE UNIT NAME AND ALL ITS COMBINATIONS",DIR("A")="ARE YOU SURE THIS IS WHAT YOU WANT TO DO?: ",DIR(0)="YA",DIR("B")="NO" D ^DIR K DIR
+ . I Y'=1 S IB95("IBCU")="" Q  ; Changed their mind - don't delete
+ . S Z=0 F  S Z=$O(^IBA(355.96,"B",IB95("IBCU"),Z)) Q:'Z  S DIK="^IBA(355.96,",DA=Z D ^DIK
+ . S DA=IB95("IBCU"),DIK="^IBA(355.95," D ^DIK
+ . W ! S DIR(0)="EA",DIR("A",1)="CARE UNIT AND ALL ITS COMBINATIONS WERE DELETED",DIR("A")="PRESS ENTER TO CONTINUE " D ^DIR K DIR D BLD^IBCEP4
+ ;
  I $P($G(^IBA(355.95,IB95("IBCU"),0)),U)'=Y S DIE="^IBA(355.95,",DR=".01///"_Y,DA=IB95("IBCU") D ^DIE ; File the name change
  S DR=".02",DIE="^IBA(355.95,",DA=IB95("IBCU") D ^DIE
@@ -152 +160 @@
  Q Y
  ;
-DELETE(IB) ; delete a care unit name
- ; IB = 0 or null if called from list manager, 1 if not
- N DIR,X,Y
- I '$G(IB) D FULL^VALM1 S Y=$$SEL() I Y'>0 G DELETEQ
- S:'$G(IB) IB95("IBCU")=+Y
- S DIR("A",1)="THIS WILL DELETE THE CARE UNIT NAME AND ALL ITS COMBINATIONS",DIR("A")="ARE YOU SURE THIS IS WHAT YOU WANT TO DO?: ",DIR(0)="YA",DIR("B")="NO" D ^DIR K DIR
- I Y'=1 S IB95("IBCU")="" Q  ; Changed their mind - don't delete
- S Z=0 F  S Z=$O(^IBA(355.96,"B",IB95("IBCU"),Z)) Q:'Z  S DIK="^IBA(355.96,",DA=Z D ^DIK
- S DA=IB95("IBCU"),DIK="^IBA(355.95," D ^DIK
- W ! S DIR(0)="EA",DIR("A",1)="CARE UNIT AND ALL ITS COMBINATIONS WERE DELETED",DIR("A")="PRESS ENTER TO CONTINUE " D ^DIR K DIR D BLD^IBCEP4
-DELETEQ ;
- S:'$G(IB) VALMBCK="R"
- Q
- ;
-SEL() ; Select entry from list
- ; returns ien in file 355.95 for selected entry
- N VALMY,SEL
- D EN^VALM2($G(XQORNOD(0)),"S")
- S SEL=+$O(VALMY(""))
- I SEL'>0 Q 0
- Q +$G(^TMP("IBPRV_CU",$J,"ZIDX",SEL))
- ;