| 1 | IB20P330 ;BPFO/OEC-POST INIT ROUTINE FOR IB*2*330 ; 11/15/05 11:21am
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**330**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | POST ; Post Init part of routine to add new rates to 350.2
|
|---|
| 7 | ;
|
|---|
| 8 | N DIC,DIK,DA,X,Y,IBX,IBA,IBT,IBY,DO,IBC,IBM,IBL,IBUP,IBY1
|
|---|
| 9 | ;
|
|---|
| 10 | S IBL=0 D M(""),M(" IB*2*330 Post-Install Starting ....."),M(""),MES^XPDUTL(.IBM) K IBM S (IBL,IBT)=0
|
|---|
| 11 | ;
|
|---|
| 12 | ; loop through entries to add (if needed)
|
|---|
| 13 | RATE F IBX=1:1 S IBY=$P($T(RATES+IBX),";",3) Q:IBY="" D
|
|---|
| 14 | . ;
|
|---|
| 15 | . ; see if it is there already
|
|---|
| 16 | . S IBA=$O(^IBE(350.1,"B",$P(IBY,"^",3),0))
|
|---|
| 17 | . I 'IBA D M(" ** Error: IB Action type "_$P(IBX,"^",3)_" not found !!!") Q
|
|---|
| 18 | . S $P(IBY,"^",3)=IBA
|
|---|
| 19 | . S IBC=$O(^IBE(350.2,"AIVDT",IBA,-$P(IBY,"^",2),0))
|
|---|
| 20 | . ;
|
|---|
| 21 | . ; add new entry
|
|---|
| 22 | . I 'IBC S DIC="^IBE(350.2,",DIC(0)="",X=$P(IBY,"^") K DO D FILE^DICN I $P(Y,"^",3) S $P(IBT,"^")=IBT+1,IBC=+Y
|
|---|
| 23 | . I 'IBC D M(" ** Error: Unable to add rate for "_$P(IBY,"^")) Q
|
|---|
| 24 | . ;
|
|---|
| 25 | . ; file data and xref
|
|---|
| 26 | . S ^IBE(350.2,+IBC,0)=IBY,DA=IBC,DIK="^IBE(350.2," D IX^DIK
|
|---|
| 27 | ;
|
|---|
| 28 | ;
|
|---|
| 29 | D M(" "_IBT_" rates added to IB ACTION CHARGE file."),M(" ")
|
|---|
| 30 | D MES^XPDUTL(.IBM) K IBM S IBL=0
|
|---|
| 31 | ;
|
|---|
| 32 | ;
|
|---|
| 33 | S IBT=0
|
|---|
| 34 | ;
|
|---|
| 35 | ; loop through entries to add (if needed)
|
|---|
| 36 | CAP F IBX=1:1 S IBY=$P($T(CAPS+IBX),";",3) Q:IBY="" D
|
|---|
| 37 | . ;
|
|---|
| 38 | . ; see if it is there already
|
|---|
| 39 | . S IBA=$O(^IBAM(354.75,"AC",$P(IBY,"^",3),$P(IBY,"^",2),0))
|
|---|
| 40 | . I IBA S IBC=$G(^IBAM(354.75,IBA,0)) I IBC=$P(IBY,"^",2,7) Q
|
|---|
| 41 | . ;
|
|---|
| 42 | . I IBA D M(" ** Error: Entry Number "_IBA_" in file 354.75 is incorrect !!!") Q
|
|---|
| 43 | . ;
|
|---|
| 44 | . ; add new entry
|
|---|
| 45 | . S DIC="^IBAM(354.75,",DIC(0)="",X=$P(IBY,"^",2) K DO D FILE^DICN S IBY1=+Y K D0
|
|---|
| 46 | . I Y<0 D M(" ** Error: Unable to add entry "_$P(IBY,"^")_" in file 354.75 !!!") Q
|
|---|
| 47 | . ;
|
|---|
| 48 | . ; file data and xref
|
|---|
| 49 | . S ^IBAM(354.75,IBY1,0)=$P(IBY,"^",2,7),DA=IBY1,DIK="^IBAM(354.75," D IX^DIK S IBT=IBT+1
|
|---|
| 50 | ;
|
|---|
| 51 | D M(" "_IBT_" caps added to IB COPAY CAPS file."),M(" ")
|
|---|
| 52 | D MES^XPDUTL(.IBM) K IBM,IBY1 S IBL=0
|
|---|
| 53 | ;
|
|---|
| 54 | D M(" IB*2*330 Post-Install Done .....")
|
|---|
| 55 | D MES^XPDUTL(.IBM)
|
|---|
| 56 | ;
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | M(Y) ; sets up messages
|
|---|
| 60 | ; Y = text to set up
|
|---|
| 61 | S IBL=IBL+1,IBM(IBL)=Y
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | RATES ; copay rates to add
|
|---|
| 65 | ;;RX1^3060101^PSO NSC RX COPAY NEW^8
|
|---|
| 66 | ;;RX3^3060101^PSO NSC RX COPAY CANCEL^8
|
|---|
| 67 | ;;RX4^3060101^PSO NSC RX COPAY UPDATE^8
|
|---|
| 68 | ;;RX2^3060101^PSO SC RX COPAY NEW^8
|
|---|
| 69 | ;;RX5^3060101^PSO SC RX COPAY CANCEL^8
|
|---|
| 70 | ;;RX6^3060101^PSO SC RX COPAY UPDATE^8
|
|---|
| 71 | ;;
|
|---|
| 72 | CAPS ; copay caps to be installed (added) (same format as in 354.75 dd)
|
|---|
| 73 | ;;1^3060101^2^^960^^C
|
|---|
| 74 | ;;2^3060101^3^^960^^C
|
|---|
| 75 | ;;3^3060101^4^^960^^C
|
|---|
| 76 | ;;4^3060101^5^^960^^C
|
|---|
| 77 | ;;5^3060101^6^^960^^C
|
|---|
