| [613] | 1 | IBEPAR1 ;ALB/MJB/AAS - MCCR PARAMETER SCREEN EDIT ;28 JUN 88 11:09
 | 
|---|
 | 2 |  ;;2.0;INTEGRATED BILLING;**51**;21-MAR-94
 | 
|---|
 | 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
 | 4 |  D Q1 W !
 | 
|---|
 | 5 |  S IBSCPP=$S($L(IBV1)>1:"1-"_$L(IBV1),1:1)
 | 
|---|
 | 6 |  F I=$Y:1:20 W !
 | 
|---|
 | 7 |  W "Enter ",IBSCPP," to EDIT, or '^' to QUIT: " R IBSCA:DTIME G Q:'$T I IBSCA=""!(IBSCA["^") G Q
 | 
|---|
 | 8 |  S IBSCNN=IBSCA
 | 
|---|
 | 9 |  I IBSCA?1N1"-"1N S IBDR=IBSCA,IBSCA="" F I=+IBDR:1:$P(IBDR,"-",2) S IBSCA=IBSCA_I_","
 | 
|---|
 | 10 |  S IBDR="" F J=1:1 S I=$P(IBSCA,",",J) Q:I=""!($L(I)>3)  I I<10 S:I'["-"&(IBDR'[I_",") IBDR=IBDR_I_"," I I["-" S I1=$P(I,"-",1),I2=$P(I,"-",2) F I3=I1:1:I2 S IBDR=IBDR_I3_"," I I3>10 Q
 | 
|---|
 | 11 |  ;
 | 
|---|
 | 12 |  I $S($L(IBSCA)>20:1,IBSCA["?":1,IBSCA'?1N.E:1,IBSCA<1:1,IBSCA>6:1,IBSCA?1"0".E:1,1:0) D ^IBCSCH Q
 | 
|---|
 | 13 |  ;
 | 
|---|
 | 14 |  S (DA,Y)=1,DIE="^IBE(350.9,",DR="[IB EDIT MCCR PARM]" D ^DIE
 | 
|---|
 | 15 |  ;
 | 
|---|
 | 16 |  K DR,DA,DIE Q
 | 
|---|
 | 17 | Q K IBDR,IBSR,IBV,IBVV,IBVI,IBVO
 | 
|---|
 | 18 | Q1 K %DT,C,DGA,DGA1,DGA2,DGAD,DGCC,IBSCAN,IBSCA,IBDR,DGST,DGAAC
 | 
|---|
 | 19 |  K DIC,DIWF,DIWL,I,I1,I2,I3,J,X,X1,X2,X3,Y,Z,Z1,Z2 Q
 | 
|---|
 | 20 |  ;
 | 
|---|
 | 21 | W I IOST="C-QUME",$L(IBVI)'=2 W Z
 | 
|---|
 | 22 |  E  W @IBVI,Z,@IBVO
 | 
|---|
 | 23 |  Q
 | 
|---|
 | 24 |  ;
 | 
|---|
 | 25 | 1 ;;1.05;1.06;1.21;1.14;
 | 
|---|
 | 26 | 2 ;;1.01;1.02;1.08;
 | 
|---|
 | 27 | 3 ;;1.11;1.03;1.15:1.19;.12;
 | 
|---|
 | 28 | 4 ;;1.1;1.2;1.04;2.07;1.07;1.09;.09;.11;
 | 
|---|
 | 29 | 5 ;;2.01:2.06;2.1
 | 
|---|
 | 30 |  ;IBPAR1
 | 
|---|