- IBEPAR1 ;ALB/MJB/AAS - MCCR PARAMETER SCREEN EDIT ;28 JUN 88 11:09
- ;;2.0;INTEGRATED BILLING;**51**;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
- S IBSCNN=IBSCA
- 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;2.1
- ;IBPAR1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEPAR1 1204 printed Jan 18, 2025@03:23:27 Page 2
- IBEPAR1 ;ALB/MJB/AAS - MCCR PARAMETER SCREEN EDIT ;28 JUN 88 11:09
- +1 ;;2.0;INTEGRATED BILLING;**51**;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 SET IBSCNN=IBSCA
- +8 IF IBSCA?1N1"-"1N
- SET IBDR=IBSCA
- SET IBSCA=""
- FOR I=+IBDR:1:$PIECE(IBDR,"-",2)
- SET IBSCA=IBSCA_I_","
- +9 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
- +10 ;
- +11 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
- +12 ;
- +13 SET (DA,Y)=1
- SET DIE="^IBE(350.9,"
- SET DR="[IB EDIT MCCR PARM]"
- DO ^DIE
- +14 ;
- +15 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;2.1
- +1 ;IBPAR1