source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IB20PT51.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1IB20PT51 ;ALB/CPM - MORE IB V2.0 POST-INIT ONE-TIME ITEMS ; 28-JAN-94
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;
4 ; Perform more one-time post-init items
5 D UBFM ; add UB-92 form type to the Form Type (#353) file
6 D RXFT ; add Addendum form type to the Form Type (#353) file
7 D FLAG ; flag telephone stop codes as non-billable
8 D HOLD ; check all charges 'on hold' in file #350
9 Q
10 ;
11 ;
12UBFM ; Add UB-92 form type to the Form Type (#353) file.
13 Q:$O(^IBE(353,"B","UB-92",0))
14 W !!,">>> Adding UB-92 form type to the Form Type (#353) file."
15 S DINUM=0 F Y=3:1:1000 I '$D(^IBE(353,Y,0))!($P($G(^IBE(353,Y,0)),U,1)="UB-92") S DINUM=Y Q
16 I 'DINUM W !!,"**** ERROR: Could not add UB-92 claim form to file 353! ****" G UBFMQ
17 S DIC="^IBE(353,",DIC(0)="LX",X="UB-92" D ^DIC
18 I '$P(Y,U,3) W !!,"**** ERROR: UB-92 Claim Form already defined! Check Routine. ****" G UBFMQ
19 I +Y>0 S DA=+Y,DIE=DIC,DR="1.01///^S X=""EN^IBCF3""" D ^DIE
20UBFMQ K DIC,DIE,DA,Y,X,DR,DINUM
21 Q
22 ;
23RXFT ; Add Addendum form type to the Form Type (#353) file.
24 W !!,">>> Adding Addendum form type to the Form Type (#353) file."
25 S DINUM=0 F Y=3:1:1000 I '$D(^IBE(353,Y,0))!($P($G(^IBE(353,Y,0)),U,1)="BILL ADDENDUM") S DINUM=Y Q
26 I 'DINUM W !!,"**** ERROR: Could not add BILL ADDENDUM claim form to file 353! ****" G RXFTE
27 S DIC="^IBE(353,",DIC(0)="LX",X="BILL ADDENDUM" D ^DIC
28 I '$P(Y,U,3) W !!,"**** ERROR: BILL ADDENDUM Claim Form already defined! Check Routine. ****" G RXFTE
29 I +Y>0 S DA=+Y,DIE=DIC,DR="1.01///^S X=""EN^IBCF4""" D ^DIE
30RXFTE K DIC,DIE,DA,Y,X,DR,DINUM
31 Q
32 ;
33FLAG ; Flag Telephone Stop Codes as non-billable for Means Test Billing
34 W !!,">>> Flagging Telephone stop codes as non-billable for Means Test Billing..."
35 F IBI=1:1 S IBS=$P($T(STOPS+IBI),";;",2) Q:IBS="QUIT" D
36 .S X=$O(^DIC(40.7,"B",IBS,0))
37 .I 'X W !?4,"Unable to flag the stop code '",IBS,"' (not on file)..." Q
38 .K DD,DO S DIC="^IBE(352.3,",DIC(0)="" D FILE^DICN Q:Y<0
39 .S DIE=DIC,DA=+Y,DR=".02////2940201;.03////1" D ^DIE
40 .W !?4,"Flagged stop code '",IBS,"' as non-billable..."
41 K DA,DIC,DIE,DR,IBI,IBS,X,Y
42 Q
43 ;
44STOPS ; Stop codes to flag
45 ;;TELEPHONE TRIAGE
46 ;;TELEPHONE/MEDICINE
47 ;;TELEPHONE/SURGERY
48 ;;TELEPHONE/SPECIAL PSYCHIATRY
49 ;;TELEPHONE/GENERAL PSYCHIATRY
50 ;;TELEPHONE/PTSD
51 ;;TELEPHONE/ALCOHOL DEPENDENCE
52 ;;TELEPHONE/DRUG DEPENDENCE
53 ;;TELEPHONE/SUBSTANCE ABUSE
54 ;;TELEPHONE/ANCILLARY
55 ;;TELEPHONE/REHAB AND SUPPORT
56 ;;TELEPHONE/DIAGNOSTIC
57 ;;TELEPHONE/PROSTHETICS/ORTHOTIC
58 ;;TELEPHONE/DENTAL
59 ;;TELEPHONE/DIALYSIS
60 ;;QUIT
61 ;
62 ;
63HOLD ; Check all charges in file #350 that are on hold.
64 ;
65 W !!,">>> Examining all charges 'on hold' in File #350..."
66 ;
67 S (IBCNTR,IBCNTU)=0
68 ;
69 ; - run through all held charges
70 S DFN=0 F S DFN=$O(^IB("AH",DFN)) Q:'DFN D
71 .S IBN=0 F S IBN=$O(^IB("AH",DFN,IBN)) Q:'IBN D
72 ..;
73 ..; - get the action and parent
74 ..S IBND=$G(^IB(IBN,0)),IBPAR=+$P(IBND,"^",9)
75 ..;
76 ..; - if the parent is itself, and there's no entry in
77 ..; - ^ib("apdt",ibpar then re-index entry
78 ..I IBN=IBPAR,'$D(^IB("APDT",IBN)) S DA=IBN,DIK="^IB(" D IX1^DIK S IBCNTR=IBCNTR+1
79 ..;
80 ..; - determine the transaction type of the last transaction
81 ..S IBL=$$LAST^IBECEAU(IBPAR)
82 ..S IBTRTY=$P($G(^IBE(350.1,+$P($G(^IB(IBL,0)),"^",3),0)),"^",5)
83 ..;
84 ..; - if the transaction was a cancel-type transaction, update
85 ..; - the status of the held charge to cancelled.
86 ..Q:IBTRTY'=2
87 ..S DA=IBN,DIE="^IB(",DR=".05////10" D ^DIE
88 ..S IBCNTU=IBCNTU+1
89 ..;
90 ..; - show signs of life
91 ..W:'(IBCNTU#10) "."
92 ;
93 ;
94 W !," >> ",$S(IBCNTU:IBCNTU,1:"No")," held charge",$S(IBCNTU=1:" was",1:"s were")," updated to cancelled."
95 W !," >> ",$S(IBCNTR:IBCNTR,1:"No")," held charge",$S(IBCNTR=1:" was",1:"s were")," re-indexed."
96 ;
97 K DA,DIK,DIE,DR,DFN,IBCNTR,IBCNTU,IBN,IBND,IBPAR,IBL,IBTRTY
98 Q
Note: See TracBrowser for help on using the repository browser.