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

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1IBCRHBC ;ALB/ARH - RATES: UPLOAD HOST FILES (CMAC DRIVER) ; 22-MAY-1996
2 ;;2.0;INTEGRATED BILLING;**52,106,124,307**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; USER SELECT FILE, DETERMINE FILE TYPE/FORMAT, CALL LOAD ROUTINE
6 ;
7CMAC ; OPTION: upload a CMAC file from a VMS file into ^XTMP
8 N IBPATH,IBFILE,IBNAME,IBMODP,IBMODT,IBFLINE,IBFORM,IBDONE,IBGLBEFF S IBDONE=""
9 ;
10 S IBNAME="IBCR UPLOAD " I '$$CONT(IBNAME) Q
11 ;
12 W !!,"Upload CMAC Host File: 'CMACxxx.TXT' or 'yyyyCMACxxx.TXT' w/xxx = locality",!
13 ;
14 S IBPATH=$$PATH I IBPATH<0 Q
15 I '$$FNDHOST(IBPATH) Q
16 ;
17 S IBFILE=$$FILE Q:IBFILE=""
18 ;
19 S IBMODP=$$MOD("","Professional") I IBMODP<0 Q
20 S IBMODT=$$MOD("","Technical") I IBMODT<0 Q
21 ;
22 D OPEN^%ZISH("CMAC UPLOAD",IBPATH,IBFILE,"R") I POP W !!,"**** Unable to open ",IBPATH,IBFILE,! Q
23 ;
24 U IO R IBFLINE:5
25 ;
26 D CLOSE^%ZISH("CMAC UPLOAD")
27 ;
28 S IBFORM=$$CHKF(IBFLINE,IBFILE) Q:'IBFORM
29 ;
30 W !!,?14,"File: ",IBFILE,?40,"Effective: ",$$DATE(IBFORM,IBFLINE)
31 I '$$CONT1 Q
32 ;
33 I IBFORM=1 S IBDONE=$$CMAC^IBCRHBC1(IBPATH,IBFILE,IBNAME,IBMODP,IBMODT)
34 I IBFORM=2 S IBDONE=$$CMAC^IBCRHBC2(IBPATH,IBFILE,IBNAME,IBMODP,IBMODT)
35 I IBFORM=3 S IBDONE=$$CMAC^IBCRHBC3(IBPATH,IBFILE,IBNAME,IBMODP,IBMODT)
36 ;
37 W !!,"Done. ",$P(IBDONE,U,1)," lines processed."
38 W !,"The following files were created, they will be purged in 2 days:" D DISP1^IBCRHU1($P(IBDONE,U,2))
39 Q
40 ;
41CHKF(LINE,FILE) ; check that first line of file fits one of the three formats, if it does return the format type, otherwise 0
42 N IBX,IBY S LINE=$G(LINE),FILE=$G(FILE),IBX=0
43 S IBY="**** Error reading file: not expected format (85, 91 or 98 numeric characters):"
44 ;
45 I (FILE'?1"CMAC"3N1".TXT"),(FILE'?4N1"CMAC"3N1".TXT") W !!,IBY,!!,"Bad file name, can not continue!" G CHKFQ
46 I LINE="" W !!,IBY,!!,"First line of file is null, can not continue!" G CHKFQ
47 ;
48 I $$LNFORM^IBCRHBC1(LINE) S IBX=1 G CHKFQ
49 I $$LNFORM^IBCRHBC2(LINE) S IBX=2 G CHKFQ
50 I $$LNFORM^IBCRHBC3(LINE) S IBX=3 G CHKFQ
51 ;
52 W !!,IBY,!,"Line Length=",$L(LINE)," characters",!!,"LINE='",LINE,"'",!!,"Can not Continue!"
53 ;
54CHKFQ Q IBX
55 ;
56CONT(XREF) ; check for existing files stored in XREF with same host file name
57 ; returns true if user wants to continue and these files are deleted
58 ;
59 N ARR,IBX,IBY,IBZ,DIR,DIRUT,DUOUT,X,Y S XREF=$G(XREF),ARR=0,IBZ=1 W !
60 ;
61 D DISP1^IBCRHU1(XREF,.ARR)
62 ;
63 I +ARR S IBZ=0 D W !
64 . W !!,"The above files already exist in XTMP." S DIR("?")="Enter either 'Y' or 'N'. These files use the same names as the new upload would use, and therefore must be deleted before the upload can proceed."
65 . S DIR("A")="Delete the above files and continue with upload",DIR(0)="Y" D ^DIR K DIR
66 . ;
67 . I Y=1 S IBZ=1,IBX="" F S IBX=$O(ARR(IBX)) Q:IBX="" K ^XTMP(IBX) W "."
68 ;
69 Q IBZ
70 ;
71MOD(DEFAULT,NAME) ; get the modifiers to use with the professional and technical component charges
72 ;
73 N IBX,DIR,DIRUT,DUOUT,DTOUT,X,Y S IBX=""
74 S DIR("?",1)="Some procedures have charges broken into professional and technical components."
75 S DIR("?",2)="To bill these components a CPT Modifier must be added with the CPT."
76 S DIR("?",3)="If no modifier is entered the "_NAME_" Component charges will not be uploaded."
77 S DIR("?")="Enter the CPT Modifier that should be used for every "_NAME_" component charge.",DIR("?",4)=""
78 ;
79 S DIR("A")=NAME_" Component Modifier",DIR("B")=$G(DEFAULT)
80 S DIR(0)="PO^DIC(81.3," D ^DIR K DIR I Y>0 S IBX=+Y
81 I $D(DUOUT)!$D(DTOUT) S IBX=-1
82 I 'IBX W !!,?7,NAME," Component charges will not be uploaded.",!
83 ;
84 Q IBX
85 ;
86CONT1() ; get final OK to start upload
87 N IBZ,DIR,DIRUT,DUOUT,X,Y S IBZ=0 W !
88 S DIR("A")="Proceed with upload now",DIR(0)="Y" D ^DIR K DIR I Y=1 S IBZ=1
89 Q IBZ
90 ;
91PATH() ; return directory or -1
92 N IBPATH,DIR,DIRUT,DUOUT,X,Y S IBPATH=""
93 S DIR("?",1)="Enter the full path specification where the host files may be found"
94 S DIR("?")="or press return for the default directory "_$$PWD^%ZISH
95 S DIR(0)="FO^3:60",DIR("A")="Enter the file path",DIR("B")=$$PWD^%ZISH D ^DIR K DIR
96 S IBPATH=$S($D(DUOUT)!$D(DTOUT):-1,1:Y)
97 Q IBPATH
98 ;
99FNDHOST(IBPATH) ; find and display any host files available for upload: 1 if some, 0 none found
100 N IBX,IBY,IBZ,IBI,IBCYR,X,Y S IBPATH=$G(IBPATH),IBZ=0
101 ;
102 S IBX("CMAC*")="",IBCYR=$S($E(DT)=2:19,1:20)_$E(DT,2,3) F IBI=IBCYR:-1:(IBCYR-10) S IBX(IBI_"CMAC*")=""
103 ;
104 W !,"CMAC Host files available for upload in: ",IBPATH,!!
105 S IBZ=$$LIST^%ZISH(IBPATH,"IBX","IBY")
106 I 'IBZ W "**** No CMAC files found ",IBPATH,"CMACxxx.TXT or yyyyCMACxxx.TXT, can not continue.",!
107 I +IBZ S IBX="" F S IBX=$O(IBY(IBX)) Q:IBX="" W ?30,$P(IBX,";",1),!
108 Q IBZ
109 ;
110FILE() ; get name of file to be loaded, returns null or file name in 'CMACxxx.TXT' or 'yyyyCMACxxx.TXT' format
111 N DIR,DIRUT,DUOUT,DTOUT,X,Y,IBX,IBY S (IBY,IBX)=""
112 S DIR("?")="Enter a CMAC Host File Name of format: 'CMACxxx.TXT' or 'yyyyCMACxxx.TXT' w/xxx = locality and w/yyyy = year charges effective"
113 S DIR(0)="FO^3:60",DIR("A")="Enter a Host File Name" D ^DIR K DIR I '$D(DIRUT) S IBY=Y
114 ;
115 I IBY'="",($E(IBY,1,4)="CMAC"),($E(IBY,5,7)?3N),($E(IBY,8,999)=".TXT") S IBX=IBY
116 I IBY'="",($E(IBY,1,4)?4N),($E(IBY,5,8)="CMAC"),($E(IBY,9,11)?3N),($E(IBY,12,999)=".TXT") S IBX=IBY
117 ;
118 I IBY'="",IBX="" W !!,"**** File not a CMAC file: must be 'CMACxxx.TXT' or 'yyyyCMACxxx.TXT'.",!
119 ;
120 Q IBX
121 ;
122DATE(FORM,LINE) ; return file formated date in FM format, returns null or file date in FM format
123 N IBX S LINE=$G(LINE),FORM=$G(FORM),(IBGLBEFF,IBX)=""
124 I FORM=1 S IBX=$$LNDT^IBCRHBC1(LINE)
125 I FORM=2 S IBX=$$LNDT^IBCRHBC2(LINE)
126 I FORM=3 S IBX=$$LNDT^IBCRHBC3(LINE)
127 I IBX'="" S IBGLBEFF=IBX,IBX=$$FMTE^XLFDT(IBX)
128 Q IBX
Note: See TracBrowser for help on using the repository browser.