source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRHD.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: 3.6 KB
Line 
1IBCRHD ;ALB/ARH - RATES: UPLOAD ASSIGN & DELETE ; 22-MAY-1996
2 ;;2.0;INTEGRATED BILLING;**52,106,115**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ACS ; OPTION: assign Charge Sets to existing XTMP files
6 ;
7 N DIR,DIRUT,DTOUT,DUOUT,X,Y,IBX,IBA1,IBA2,IBFILE,IBCS,IBBI1,IBBI2
8 W !!,"Assign charges loaded into XTMP to Charge Sets.",!
9 ;
10ACS1 W !,"------------------------------------------------------------------------------"
11 D DISP1^IBCRHU1("",.IBA1,.IBA2) I 'IBA1 W !,"No files in XTMP." Q
12 ;
13 S DIR("A")="Assign Charge Set to which file",DIR(0)="NO^1:"_+IBA1 D ^DIR K DIR I 'Y!$D(DIRUT) Q
14 S IBFILE=IBA2(+Y) Q:IBFILE="" W !!,?5,$P(IBFILE,U,1),?40,$P(IBFILE,U,2),!
15 ;
16 S IBCS=$$GETCS^IBCRU1 I IBCS<0 G ACS1
17 ;
18 I +IBCS W !!,?7,"Charge Set: ",$P($G(^IBE(363.1,+IBCS,0)),U,1),?45,"Billable Item: ",$P($$CSBI^IBCRU3(+IBCS),U,2),!
19 I +IBCS S IBX=$$CHKFL^IBCRHU1(IBCS,$P(IBFILE,U,1),$P(IBFILE,U,2)) I +IBX D EOP G ACS1
20 I 'IBCS W !!,"Charge Set will be removed from the file."
21 ;
22 I $D(^XTMP($P(IBFILE,U,1),$P(IBFILE,U,2))) S $P(^XTMP($P(IBFILE,U,1),$P(IBFILE,U,2)),U,3)=+IBCS
23 G ACS1
24 Q
25 ;
26DEL ; OPTION: delete files in XTMP
27 ;
28 N DIR,DIRUT,DTOUT,DUOUT,X,Y,IBX,IBA2,IBA3,IBFILES,IBI,IBF1,IBF2
29 W !!,"Delete files in XTMP:"
30 W !,"------------------------------------------------------------------------------"
31 D DISP1^IBCRHU1("","",.IBA2) I 'IBA2 W !,"No files in XTMP." Q
32 ;
33 S DIR("A")="Delete which files",DIR(0)="LO^1:"_+IBA2 D ^DIR K DIR I 'Y!$D(DIRUT) Q
34 ;
35 S IBFILES=Y F IBI=1:1 S IBF1=$P(IBFILES,",",IBI) Q:'IBF1 S IBA3(IBF1)=$G(IBA2(IBF1)),IBA3=+$G(IBA3)+1
36 I 'IBA3 W !,"No files selected.",! Q
37 ;
38 W !!,"The following files will be deleted:",!!
39 S IBI=0 F S IBI=$O(IBA3(IBI)) Q:'IBI W $P(IBA3(IBI),U,1),?40,$P(IBA3(IBI),U,2),!
40 I '$$CONT W !,"No change." Q
41 ;
42 ; delete selected XTMP files
43 S IBI=0 F S IBI=$O(IBA3(IBI)) Q:'IBI D
44 . S IBF1=$P(IBA3(IBI),U,1),IBF2=$P(IBA3(IBI),U,2) I (IBF1="")!(IBF2="") Q
45 . K ^XTMP(IBF1,IBF2) W !,IBF1,?40,IBF2,?65,"... deleted."
46 . I $O(^XTMP(IBF1,0))="" K ^XTMP(IBF1) W !,IBF1,?65,"... deleted.",!
47 ;
48 ; delete National Reasonable Charges XTMP files if after delete date
49 S IBF1="IBCR RC",IBI=$O(^XTMP(IBF1)) I IBI[IBF1 D
50 . S IBX=$G(^XTMP(IBI,0)) I DT'>+IBX Q
51 . W !!,"Deleting Reasonable Charges XTMP files",!,"uploaded from Host Files on ",$$FMTE^XLFDT($P(IBX,U,2))
52 . S IBI=IBF1 F S IBI=$O(^XTMP(IBI)) Q:IBI'[IBF1 K ^XTMP(IBI) W "."
53 W !!
54 Q
55 ;
56CONT() ; continue y/n
57 N IBZ,DIR,DIRUT,DTOUT,DUOUT,X,Y S IBZ=0
58 S DIR("A")="Is this correct, do you want to continue",DIR(0)="Y" D ^DIR K DIR I Y=1 S IBZ=1 W !
59 Q IBZ
60 ;
61EOP ; continue at end of page of display
62 N DIR,DIRUT,DTOUT,DUOUT,X,Y W !,"*** ",$P($P(IBX,U,2),")",1),")",!,?16,$P($P(IBX,U,2),")",2,99),!
63 S DIR(0)="E" D ^DIR K DIR W !
64 Q
65 ;
66OPTION ; OPTION: MAIN ENTRY POINT FOR LOADING FILES INTO THE CHARGE MASTER
67 ;
68 N DIR,DIRUT,DTOUT,DUOUT,X,Y
69 ;
70UP1 S DIR(0)="SO^1.1:Load CMAC into XTMP;1.2:Load AWP into XTMP;1.3:Load RC into XTMP;1.4:Load TP into XTMP;2:Assign Charge Set;3:Check Data Validity;4:Load into Charge Master;5:Delete XTMP files"
71 D ^DIR K DIR I 'Y!$D(DIRUT) Q
72 ;
73 I +Y=1.1 D CMAC^IBCRHBC G UP1
74 I +Y=1.2 D AWP^IBCRHBA G UP1
75 I +Y=1.3 D RC^IBCRHBR G UP1
76 I +Y=1.4 D TP^IBCRHBT G UP1
77 I +Y=2 D ACS^IBCRHD G UP1
78 I +Y=3 D ENTRY^IBCRHO(0) G UP1
79 I +Y=4 D ENTRY^IBCRHO(1) G UP1
80 I +Y=5 D DEL^IBCRHD G UP1
81 Q
82 ;
83 ;
84 ; Format of XTMP file created from host files to load into Charge Master:
85 ; ^XTMP(XRF1, 0) = delete DT ^ loaded DT ^ Name, time, user ^ total count
86 ; ^XTMP(XRF1, XRF2) = subfile count ^ billable item type ^ Charge Set (added by user)
87 ; ^XTMP(XRF1, XRF2, x) = item ptr ^ eff dt ^ inactive dt ^ $ charge ^ modifier ptr
Note: See TracBrowser for help on using the repository browser.