source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IB20P330.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 2.5 KB
Line 
1IB20P330 ;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 ;
6POST ; 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)
13RATE 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)
36CAP 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 ;
59M(Y) ; sets up messages
60 ; Y = text to set up
61 S IBL=IBL+1,IBM(IBL)=Y
62 Q
63 ;
64RATES ; 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 ;;
72CAPS ; 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
Note: See TracBrowser for help on using the repository browser.