Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEPA.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/IBCEPA.m (modified) (11 diffs)

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

@@ -1 +1 @@
 IBCEPA ;ALB/WCJ - Provider ID functions - Care Units ;21-OCT-2005
- ;;2.0;INTEGRATED BILLING;**320,348,377**;21-MAR-94;Build 23
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
+ ;;2.0;INTEGRATED BILLING;**320,348**;21-MAR-94;Build 5
 EN ; -- main entry point for IBCE 2ND PRVID CARE UNIT MAINT
  D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT")
@@ -27 +25 @@
  D CLEAN^VALM10
  K ^TMP("IBPRV_CU",$J)
- N TAR,MSG,I,D0,IBCT,Z,DIV,SCREEN
+ N TAR,MSG,I,D0,IBLCT,Z,DIV,SCREEN
  ;
  S VALMBG=1
@@ -51 +49 @@
  ... S IN=^TMP("IBPRV_CU",$J,"SORT",DIV,D0)
  ... S Z=$J("",2)
- ... S Z=Z_$E(IN_"    ",1,4)_$E(TAR("DILIST","ID",IN,.01),1,36)
+ ... S Z=Z_$E(TAR("DILIST","ID",IN,.01),1,36)
  ... S Z=Z_$J("",40-$L(Z))
  ... S Z=Z_$E(TAR("DILIST","ID",IN,.02),1,38)
  ... S IBCT=IBCT+1
  ... D SET^VALM10(IBCT,Z)
- ;
- ; correct the VALMCNT variable - number of lines in the list (not entries)
- S VALMCNT=+$O(@VALMAR@(""),-1)
  Q
  ;
@@ -67 +62 @@
 EXIT ; -- exit code
  D CLEAN^VALM10
- K ^TMP("IBPRV_CU",$J)
  Q
  ;
@@ -76 +70 @@
  ; Assumes IBINS is defined as ins co ien (file 36)
  ; IB = 0 or null if called from list manager, 1 if not
- N DIC,DIR,X,Y,Z,D,DA,DR,DIE,DO,DD,DLAYGO,IB95,IBADD,IBOK,IBDIV,MAIN,IBDIVNM
+ N DIC,DIR,X,Y,Z,DA,DR,DIE,DO,DD,DLAYGO,IB95,IBADD,IBOK,IBDIV,MAIN,IBDIVNM
  ;
  D FULL^VALM1
@@ -85 +79 @@
  S MAIN=$$EXTERNAL^DILFD(355.92,.05,"",MAIN)
  S DIC=40.8,DIC("A")="Enter the Division for this Care Unit: ",DIC("B")=MAIN,DIC(0)="AEMQ"
- S D="B^C"
- D MIX^DIC1
+ D ^DIC
  I Y'>0 G NEWQ
  S IBDIV=+Y
@@ -153 +146 @@
 CHANGE ; Edit care unit
  ; Assumes IBINS is defined as ins co ien (file 36)
- ;
+ ; 
  D FULL^VALM1
  ;
- N X,Y,Z,D,DA,DD,DIC,DIK,DIR,IBDIV,CAREUNIT,SCREEN,TAR,DIVISION,I
+ N X,Y,Z,DA,DD,DIC,DIK,DIR,IBDIV,CAREUNIT,SCREEN,TAR,DIVISION
  ;
  S SCREEN="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)]"""""
@@ -173 +166 @@
  S DIC(0)="AEMQ"
  S DIC("S")="I $D(DIVISION($P(^(0),U)))"
- S D="B^C"
- D MIX^DIC1
+ D ^DIC
  I Y'>0 G CHANGEQ
  S IBDIV=+Y
- S DA=$$SEL($P(Y,U,2)) I 'DA G CHANGEQ
- S DIE=355.95
+ ;
+ S DIC("A")="Enter the Care Unit name: "
+ S DIC=355.95,DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="AEMQ"
+ D ^DIC
+ I Y<1 G CHANGEQ
+ ;
+ S DA=+Y,DIE=355.95
  S DR=".01Care Unit;.04Division;.02Description"
  D ^DIE
@@ -191 +188 @@
  ; 
  D FULL^VALM1
- N X,Y,Z,D,DA,DD,DIC,DIK,DIR,IBDIV,CAREUNIT,SCREEN,TAR,DIVISION
+ N X,Y,Z,DA,DD,DIC,DIK,DIR,IBDIV,CAREUNIT,SCREEN,TAR,DIVISION
  ;
  S SCREEN="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)]"""""
@@ -208 +205 @@
  S DIC(0)="AEMQ"
  S DIC("S")="I $D(DIVISION($P(^(0),U)))"
- S D="B^C"
- D MIX^DIC1
+ D ^DIC
  I Y'>0 G DELQ
  S IBDIV=+Y
- S CAREUNIT=$$SEL($P(Y,U,2)) I 'CAREUNIT G DELQ
+ ;
+ K DIC
+ S DIC("A")="Enter the Care Unit name: "
+ S DIC=355.95,DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="AEMQ"
+ D ^DIC
+ I Y<1 G DELQ
+ S CAREUNIT=+Y
  ;
  I $D(^IBA(355.92,"AC",+Y)) D  G DELQ
@@ -244 +246 @@
  Q
  ;
-SEL(DIV) ; select care unit for a given division
- ; DIV - name of division
- ; returns ien of selected care unit, or 0 if nothing is selected
- N DIR,I,IEN,MIN,MAX,X,Y
- I $G(DIV)="" Q 0
- S IEN=0
- S I=$O(^TMP("IBPRV_CU",$J,"SORT",DIV,"")),MIN=$G(^TMP("IBPRV_CU",$J,"SORT",DIV,I))
- S I=$O(^TMP("IBPRV_CU",$J,"SORT",DIV,""),-1),MAX=$G(^TMP("IBPRV_CU",$J,"SORT",DIV,I))
- I MIN=MAX S IEN=I
- I MIN'=MAX D
- .S DIR("A")="Select CARE UNITS",DIR(0)="N^"_MIN_":"_MAX_":0" D ^DIR
- .Q:$D(DTOUT)!$D(DUOUT)
- .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
- .Q
- Q IEN