| 1 | IBCSCP ;ALB/MRL - BILLING SCREEN PROCESSOR ;01 JUN 88 12:00
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,51,161,266**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;MAP TO DGCRSCP
|
|---|
| 6 | ;
|
|---|
| 7 | D Q1 W !
|
|---|
| 8 | S IBCSCPP=$S($L(IBV1)>1:"1-"_$L(IBV1),1:1)
|
|---|
| 9 | F I=$Y:1:20 W !
|
|---|
| 10 | S IBPOPOUT=0
|
|---|
| 11 | S (ICDVDT,ICPTVDT)=$$BDATE^IBACSV(IBIFN) ;ICD/CPT version date
|
|---|
| 12 | W "<RET> to ",$S(+IBSR<9:"CONTINUE",1:"QUIT") W:$S(+IBSR=9&(IBV1'["0"):0,1:'IBV) ", ",IBCSCPP," to EDIT," W " '^N' for screen N, or '^' to QUIT: " R IBSCNN:DTIME S IBCITOUT='$T G Q:'$T I IBSCNN="" S X1=2 G NOMO
|
|---|
| 13 | G AN:IBSCNN?1"^"1N.N
|
|---|
| 14 | I IBSCNN?1"^".E S IBPOPOUT=1 G Q
|
|---|
| 15 | I IBSCNN'?1N.E D ^IBCSCH S X=IBSR,X1=2 G NOMO2
|
|---|
| 16 | I IBSCNN?1N1"-"1N S IBDR20=IBSCNN,IBSCNN="" F I=+IBDR20:1:$P(IBDR20,"-",2) S IBSCNN=IBSCNN_I_","
|
|---|
| 17 | S IBDR20="" F J=1:1 S I=$P(IBSCNN,",",J) Q:I=""!($L(I)>3) I I<10 S:I'["-"&(IBDR20'[I_",") IBDR20=IBDR20_I_"," I I["-" S I1=$P(I,"-",1),I2=$P(I,"-",2) F I3=I1:1:I2 S IBDR20=IBDR20_I3_"," I I3>10 Q
|
|---|
| 18 | S DGDR1="" F J=1:1 S I=$P(IBDR20,",",J) Q:I="" I '$E(IBV1,I) S DGDR1=DGDR1_(I+(IBSR*10))_","
|
|---|
| 19 | I DGDR1']"" D ^IBCSCH S X=IBSR,X1=2 G NOMO2
|
|---|
| 20 | S IBDR20=DGDR1 D ^IBCSCE S X=IBSR,X1=2 G NOMO2
|
|---|
| 21 | Q K IBSR,IBVV,VADM,IBVI,IBVO,ICDVDT,ICPTVDT
|
|---|
| 22 | ;
|
|---|
| 23 | ; If Ingenix ClaimsManager found some errors and the user is trying
|
|---|
| 24 | ; to exit from these screens, then capture the user's comments.
|
|---|
| 25 | ; Exit by time-out or by "^" pop out.
|
|---|
| 26 | ; Here, it's important to preserve the value of $T since it is
|
|---|
| 27 | ; being looked at by IBCB.
|
|---|
| 28 | ;
|
|---|
| 29 | S IBCIT("SAVE THE VALUE OF $T")=$T ; save $T
|
|---|
| 30 | I $$CM^IBCIUT1(IBIFN),$P($G(^IBA(351.9,IBIFN,0)),U,2)=4,($G(IBPOPOUT)!$G(IBCITOUT)) D COMMENT^IBCIUT7(IBIFN,1)
|
|---|
| 31 | I IBCIT("SAVE THE VALUE OF $T") ; restore $T
|
|---|
| 32 | ;
|
|---|
| 33 | Q1 K %DT,C,DGA,DGA1,DGA2,DGAD,DGCC,IBSCNN,IBCSCPP,IBDR20,DGDR1,DGST,DGAAC,DGRCD,IBCPTX,IBCITOUT,IBCIT
|
|---|
| 34 | K IBA,IBCPT,IBREVC,IBYN,IBZZ,IBABRT,IB,IBDD,IBIDS,IBIR,IBIRN,IBISEX,IBIUTL,IBU,IBUN,IBW,IBWW,DGPT,IBICD,IBHC,IBCC,IBDI,IBDIN,IBDPT,IBUCH
|
|---|
| 35 | K DIC,DIWF,DIWL,I,I1,I2,I3,J,X,X1,X2,X3,Y,Z,Z1,Z2
|
|---|
| 36 | Q
|
|---|
| 37 | NOMO S I=IBSR,J=1 I +IBSR=9 S X=IBSR G NOMO2
|
|---|
| 38 | NOMO1 S I=I+1,J=+$E(IBVV,I),X=I S:J&(+X=9) IBSR=X G NOMO2:+X=9 I J G NOMO1
|
|---|
| 39 | NOMO2 I +IBSR=9&(IBSCNN="") S X1=3,IBSR1=""
|
|---|
| 40 | S:+IBSR=8&(IBSCNN="") IBSR1="" S X=$P($T(@(IBSR1_X)),";;",X1) G @X
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | AN S X=+$E(IBSCNN,2,99),X1=$P($T(@X),";;",2) I X1]"",'$E(IBVV,X) S IBSR1="",X1=2 G NOMO2
|
|---|
| 44 | S Z="INVALID SCREEN NUMBER...VALID SCREENS ARE " F I=1:1:9 I '$E(IBVV,I) S Z=Z_I_$S(I<9:",",1:".")
|
|---|
| 45 | W !,*7 D W H 1 S X=IBSR,X1=2 G NOMO2
|
|---|
| 46 | W ;I IOST="C-QUME",$L(IBVI)'=2 W Z
|
|---|
| 47 | W IBVI,Z,IBVO
|
|---|
| 48 | Q
|
|---|
| 49 | 1 ;;^IBCSC1;;^IBCSC2
|
|---|
| 50 | 2 ;;^IBCSC2;;^IBCSC3
|
|---|
| 51 | 3 ;;^IBCSC3;;^IBCSC4
|
|---|
| 52 | 4 ;;^IBCSC4;;^IBCSC5
|
|---|
| 53 | 5 ;;^IBCSC5;;^IBCSC6
|
|---|
| 54 | 6 ;;^IBCSC6;;^IBCSC7
|
|---|
| 55 | 7 ;;^IBCSC7;;^IBCSC8
|
|---|
| 56 | 8 ;;^IBCSC8;;^IBCSC9
|
|---|
| 57 | 9 ;;^IBCSC9;;Q^IBCSCP
|
|---|
| 58 | 28 ;;^IBCSC82;;^IBCSC9
|
|---|
| 59 | H8 ;;^IBCSC8H;;^IBCSC9
|
|---|
| 60 | PAR ;;^IBCPAR;;^IBCPAR
|
|---|
| 61 | ;IBCSCP
|
|---|
