Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCSCP

IBCSCP.m

Go to the documentation of this file.
  1. IBCSCP ;ALB/MRL - BILLING SCREEN PROCESSOR ;01 JUN 88 12:00
  1. ;;2.0;INTEGRATED BILLING;**52,51,161,266,432,447,547**;21-MAR-94;Build 119
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;MAP TO DGCRSCP
  1. ;
  1. D Q1 W !
  1. S IBCSCPP=$S($L(IBV1)>1:"1-"_$L(IBV1),1:1)
  1. F I=$Y:1:20 W !
  1. S IBPOPOUT=0
  1. S (ICDVDT,ICPTVDT)=$$BDATE^IBACSV(IBIFN) ;ICD/CPT version date
  1. ; IB*2.0*447 BI Start
  1. ;W "<RET> to ",$S(+IBSR<10:"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
  1. W "<RET> to ",$S(+IBSR<11:"CONTINUE",1:"QUIT") W:$S(+IBSR=11&(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
  1. ; IB*2.0*447 BI End
  1. G AN:IBSCNN?1"^"1N.N
  1. I IBSCNN?1"^".E S IBPOPOUT=1 G Q
  1. I IBSCNN'?1N.E D ^IBCSCH S X=IBSR,X1=2 G NOMO2
  1. ;
  1. ; WCJ;IB*2*547;allow more than 9 sections on a screen
  1. ;I IBSCNN?1N1"-"1N S IBDR20=IBSCNN,IBSCNN="" F I=+IBDR20:1:$P(IBDR20,"-",2) S IBSCNN=IBSCNN_I_","
  1. I IBSCNN?1N1"-"1.2N,$P(IBSCNN,"-",2)'>$L(IBV1) S IBDR20=IBSCNN,IBSCNN="" F I=+IBDR20:1:$P(IBDR20,"-",2) S IBSCNN=IBSCNN_I_","
  1. ;
  1. ; IB*2.0*447 BI Start
  1. S IBDR20="" F J=1:1 S I=$P(IBSCNN,",",J) Q:I=""!($L(I)>3) I I<11 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>11 Q
  1. ; IB*2.0*447 BI End
  1. S DGDR1="" F J=1:1 S I=$P(IBDR20,",",J) Q:I="" I '$E(IBV1,I) S DGDR1=DGDR1_(I+(IBSR*10))_","
  1. I DGDR1']"" D ^IBCSCH S X=IBSR,X1=2 G NOMO2
  1. S IBDR20=DGDR1 D ^IBCSCE S X=IBSR,X1=2 G NOMO2
  1. Q K IBSR,IBVV,VADM,IBVI,IBVO,ICDVDT,ICPTVDT
  1. ;
  1. ; If Ingenix ClaimsManager found some errors and the user is trying
  1. ; to exit from these screens, then capture the user's comments.
  1. ; Exit by time-out or by "^" pop out.
  1. ; Here, it's important to preserve the value of $T since it is
  1. ; being looked at by IBCB.
  1. ;
  1. S IBCIT("SAVE THE VALUE OF $T")=$T ; save $T
  1. I $$CM^IBCIUT1(IBIFN),$P($G(^IBA(351.9,IBIFN,0)),U,2)=4,($G(IBPOPOUT)!$G(IBCITOUT)) D COMMENT^IBCIUT7(IBIFN,1)
  1. I IBCIT("SAVE THE VALUE OF $T") ; restore $T
  1. ;
  1. Q1 K %DT,C,DGA,DGA1,DGA2,DGAD,DGCC,IBSCNN,IBCSCPP,IBDR20,DGDR1,DGST,DGAAC,DGRCD,IBCPTX,IBCITOUT,IBCIT
  1. 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
  1. K DIC,DIWF,DIWL,I,I1,I2,I3,J,X,X1,X2,X3,Y,Z,Z1,Z2
  1. Q
  1. ; IB*2.0*447 BI Start
  1. NOMO S I=IBSR,J=1 I +IBSR=11 S X=IBSR G NOMO2
  1. NOMO1 S I=I+1,J=+$E(IBVV,I),X=I S:J&(+X=11) IBSR=X G NOMO2:+X=11 I J G NOMO1
  1. NOMO2 I +IBSR=11&(IBSCNN="") S X1=3,IBSR1=""
  1. S:(+IBSR=10)&(IBSCNN="") IBSR1="" S X=$P($T(@(IBSR1_X)),";;",X1) G @X
  1. Q
  1. ; IB*2.0*447 BI End
  1. ;
  1. AN S X=+$E(IBSCNN,2,99),X1=$P($T(@X),";;",2) I X1]"",'$E(IBVV,X) S IBSR1="",X1=2 G NOMO2
  1. ; IB*2.0*447 BI Start
  1. S Z="INVALID SCREEN NUMBER...VALID SCREENS ARE " F I=1:1:11 I '$E(IBVV,I) S Z=Z_I_$S(I<11:",",1:".")
  1. ; IB*2.0*447 BI End
  1. W !,*7 D W H 1 S X=IBSR,X1=2 G NOMO2
  1. W ;I IOST="C-QUME",$L(IBVI)'=2 W Z
  1. W IBVI,Z,IBVO
  1. Q
  1. 1 ;;^IBCSC1;;^IBCSC2
  1. 2 ;;^IBCSC2;;^IBCSC3
  1. 3 ;;^IBCSC3;;^IBCSC4
  1. 4 ;;^IBCSC4;;^IBCSC5
  1. 5 ;;^IBCSC5;;^IBCSC6
  1. 6 ;;^IBCSC6;;^IBCSC7
  1. 7 ;;^IBCSC7;;^IBCSC8
  1. 8 ;;^IBCSC8;;^IBCSC9
  1. 9 ;;^IBCSC9;;^IBCSC10
  1. ; IB*2.0*447 BI Start
  1. 10 ;;^IBCSC10;;^IBCSC11
  1. 210 ;;^IBCSC102;;^IBCSC11
  1. H10 ;;^IBCSC10H;;^IBCSC11
  1. 11 ;;^IBCSC11;;Q^IBCSCP
  1. ; IB*2.0*447 BI End
  1. PAR ;;^IBCPAR;;^IBCPAR
  1. ;IBCSCP