IBEPAR1.m

IBEPAR1	;ALB/MJB/AAS - MCCR PARAMETER SCREEN EDIT  ;28 JUN 88 11:09

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	D Q1 W !

	S IBSCPP=$S($L(IBV1)>1:"1-"_$L(IBV1),1:1)

	F I=$Y:1:20 W !

	W "Enter ",IBSCPP," to EDIT, or '^' to QUIT: " R IBSCA:DTIME G Q:'$T I IBSCA=""!(IBSCA["^") G Q

	I IBSCA?1N1"-"1N S IBDR=IBSCA,IBSCA="" F I=+IBDR:1:$P(IBDR,"-",2) S IBSCA=IBSCA_I_","

	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

	;

	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

	;

	S (DA,Y)=1,DIE="^IBE(350.9,",DR="[IB EDIT MCCR PARM]" D ^DIE

	;

	K DR,DA,DIE Q

Q	K IBDR,IBSR,IBV,IBVV,IBVI,IBVO

Q1	K %DT,C,DGA,DGA1,DGA2,DGAD,DGCC,IBSCAN,IBSCA,IBDR,DGST,DGAAC

	K DIC,DIWF,DIWL,I,I1,I2,I3,J,X,X1,X2,X3,Y,Z,Z1,Z2 Q

	;

W	I IOST="C-QUME",$L(IBVI)'=2 W Z

	E  W @IBVI,Z,@IBVO

	Q

	;

1	;;1.05;1.06;1.21;1.14;

2	;;1.01;1.02;1.08;

3	;;1.11;1.03;1.15:1.19;.12;

4	;;1.1;1.2;1.04;2.07;1.07;1.09;.09;.11;

5	;;2.01:2.06

	;IBPAR1

IBEPAR1   ;ALB/MJB/AAS - MCCR PARAMETER SCREEN EDIT  ;28 JUN 88 11:09

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        DO Q1

           WRITE !

 +4        SET IBSCPP=$SELECT($LENGTH(IBV1)>1:"1-"_$LENGTH(IBV1),1:1)

 +5        FOR I=$Y:1:20

               WRITE !

 +6        WRITE "Enter ",IBSCPP," to EDIT, or '^' to QUIT: "

           READ IBSCA:DTIME

           IF '$TEST

               GOTO Q

           IF IBSCA=""!(IBSCA["^")

               GOTO Q

 +7        IF IBSCA?1N1"-"1N

               SET IBDR=IBSCA

               SET IBSCA=""

               FOR I=+IBDR:1:$PIECE(IBDR,"-",2)

                   SET IBSCA=IBSCA_I_","

 +8        SET IBDR=""

           FOR J=1:1

               SET I=$PIECE(IBSCA,",",J)

               IF I=""!($LENGTH(I)>3)

                   QUIT 

               IF I<10

                   IF I'["-"&(IBDR'[I_",")

                       SET IBDR=IBDR_I_","

                   IF I["-"

                       SET I1=$PIECE(I,"-",1)

                       SET I2=$PIECE(I,"-",2)

                       FOR I3=I1:1:I2

                           SET IBDR=IBDR_I3_","

                           IF I3>10

                               QUIT 

 +9       ;

 +10       IF $SELECT($LENGTH(IBSCA)>20:1,IBSCA["?":1,IBSCA'?1N.E:1,IBSCA<1:1,IBSCA>6:1,IBSCA?1"0".E:1,1:0)

               DO ^IBCSCH

               QUIT 

 +11      ;

 +12       SET (DA,Y)=1

           SET DIE="^IBE(350.9,"

           SET DR="[IB EDIT MCCR PARM]"

           DO ^DIE

 +13      ;

 +14       KILL DR,DA,DIE

           QUIT 

Q          KILL IBDR,IBSR,IBV,IBVV,IBVI,IBVO

Q1         KILL %DT,C,DGA,DGA1,DGA2,DGAD,DGCC,IBSCAN,IBSCA,IBDR,DGST,DGAAC

 +1        KILL DIC,DIWF,DIWL,I,I1,I2,I3,J,X,X1,X2,X3,Y,Z,Z1,Z2

           QUIT 

 +2       ;

W          IF IOST="C-QUME"

               IF $LENGTH(IBVI)'=2

                   WRITE Z

 +1       IF '$TEST

               WRITE @IBVI,Z,@IBVO

 +2        QUIT 

 +3       ;

1         ;;1.05;1.06;1.21;1.14;

2         ;;1.01;1.02;1.08;

3         ;;1.11;1.03;1.15:1.19;.12;

4         ;;1.1;1.2;1.04;2.07;1.07;1.09;.09;.11;

5         ;;2.01:2.06

 +1       ;IBPAR1