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

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1IBCRHO ;ALB/ARH - RATES: UPLOAD CHECK & ADD TO CM REPORT ; 22-MAY-1996
2 ;;2.0;INTEGRATED BILLING;**52,138,148,307**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ENTRY(ADD) ; OPTION: check validity of data in uploaded files and add to Charge Master
6 ;
7 W !!,"Check files waiting to be loaded into the Charge Master for data validity."
8 D DISP1^IBCRHU1("",.IBA1,"",1) I 'IBA1 W !,"No files in XTMP." G EXIT
9 ;
10 I +$G(ADD),'$$CONT G EXIT
11 ;
12 ;get the device
13 W !!,"Report requires 120 columns"
14 S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
15 I $D(IO("Q")) S ZTRTN="RPT^IBCRHO",ZTDESC="IBCR UPLOAD REPORT",ZTSAVE("ADD")=+$G(ADD) D ^%ZTLOAD K IO("Q") G EXIT
16 ;
17 ;
18RPT N IBX,IBQUIT S IBQUIT=0 K ^TMP($J)
19 D GETXTMP^IBCRHU1("",.IBA1,"",1)
20 S IBX="" F S IBX=$O(IBA1(IBX)) Q:IBX="" D SRCH^IBCRHL(IBX,+$G(ADD)) S IBQUIT=$$STOP Q:IBQUIT
21 ;
22 I 'IBQUIT,+$G(ADD) S IBX=$O(IBA1("")) I IBX'="" S IBX=$G(IBA1(IBX)) I IBX["RC v1 " D CPT2000^IBCRHBRA
23 I 'IBQUIT,+$G(ADD) S IBX=$O(IBA1("")) I IBX'="" S IBX=$G(IBA1(IBX)) I IBX["RC " S IBX=$$CSEMPTY^IBCRED("RC")
24 I 'IBQUIT,+$G(ADD) S IBX=$O(IBA1("")) I IBX'="" S IBX=$G(IBA1(IBX)) I IBX["CMAC" S IBX=$$CSEMPTY^IBCRED("CM")
25 ;
26 I 'IBQUIT D PRNT
27 ;
28EXIT ;clean up and quit
29 K ^TMP($J),IBA1 Q:$D(ZTQUEUED) D ^%ZISC
30 Q
31 ;
32PRNT ; print report
33 N IBFILE,IBSUB,IBX,IBY,IBLN,IBCNT,IBPG,IBTIME,IBQUIT,DIR,DIRUT,X,Y S IBTIME=$H
34 U IO
35 Q:$$HDR
36 S IBFILE="" F S IBFILE=$O(^TMP($J,IBFILE)) Q:IBFILE="" D Q:IBQUIT
37 . W !!,?15,IBFILE S IBCNT=IBCNT+2
38 . S IBSUB="" F S IBSUB=$O(^TMP($J,IBFILE,IBSUB)) Q:IBSUB="" D S:IBCNT>(IOSL-5) IBQUIT=$$HDR Q:IBQUIT
39 .. S IBLN=$G(^TMP($J,IBFILE,IBSUB))
40 .. W !!,IBSUB,?20,$P(IBLN,U,2),! S IBCNT=IBCNT+4
41 .. I $P(IBLN,U,3)'="" W ?20,$P(IBLN,U,3),! S IBCNT=IBCNT+1
42 .. I $P(IBLN,U,4)'="" W ?20,$P(IBLN,U,4),! S IBCNT=IBCNT+1
43 .. ;
44 .. S IBX=0 F S IBX=$O(^TMP($J,IBFILE,IBSUB,IBX)) Q:'IBX D S:IBCNT>(IOSL-5) IBQUIT=$$HDR Q:IBQUIT
45 ... S IBY=$P(^TMP($J,IBFILE,IBSUB,IBX),U,2)
46 ... W !,?5,IBX,?10," = ",$G(^XTMP(IBFILE,IBSUB,IBX)),?50,$E(IBY,1,69) S IBCNT=IBCNT+1
47 ... S IBY=$E(IBY,70,999) I IBY'="" W !,?70,IBY S IBCNT=IBCNT+1
48 ;
49 I 'IBQUIT,IBCNT>(IOSL-12) S IBQUIT=$$HDR
50 I 'IBQUIT D
51 . W !!,"SUBFILE/SET ERROR:",?20,"This error results when a problem is found in the definition of the subfile that has been uploaded",!,"or the Charge Set that has been assigned to it. All processing of the subfile"
52 . W " is stopped, no part of the subfile will",!,"be loaded into the Charge Master."
53 . W !!,"LINE/DATA ERROR:",?20,"A data error in a required field has been found in a line read from the file. The chargeable item",!,"defined by that line will be ignored, it will NOT be added to the Charge Master."
54 . W !!,"LINE/DATA WARNING:",?20,"A data error in a non-required field has been found in a line read from the file. The chargeable",!,"item defined by that line will be ignored, it will NOT be added to the Charge Master."
55 . W !!,"Records found that are duplicates of existing charge entries or have a 0 charge are NOT added nor reported individually."
56 Q
57 ;
58PAUSE ;pause at end of screen if being displayed on a terminal
59 Q:$E(IOST,1,2)'["C-" S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DIRUT)) S IBQUIT=1
60 Q
61 ;
62CONT() ; returns true if user wants to add the files to the Charge Master
63 N IBZ,DIR,DIRUT,DUOUT,X,Y S IBZ=0
64 S DIR("A")="Load the above files into the Charge Master",DIR(0)="Y" D ^DIR K DIR I Y=1 S IBZ=1
65 I +IBZ W !,"A summary report of the results will be printed.",!
66 Q IBZ
67 ;
68HDR() ;print the report header
69 S IBQUIT=0,IBPG=$G(IBPG)+1,IBCNT=3
70 S IBQUIT=$$STOP G:IBQUIT HDRQ I IBPG>1 D PAUSE G:IBQUIT HDRQ
71 W @IOF
72 I +$G(ADD) W !,"IB Upload Summary Report of Charge Items Loaded into the Charge Master"
73 I '$G(ADD) W !,"IB Upload Data Validity Check on Temporary files"
74 W ?75,$$HTE^XLFDT(IBTIME,2)_" Page ",IBPG
75 W !,"---------------------------------------------------------------------------------------------------"
76HDRQ Q IBQUIT
77 ;
78STOP() ;determine if user has requested the queued report to stop
79 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPG) W !,"***TASK STOPPED BY USER***"
80 Q +$G(ZTSTOP)
Note: See TracBrowser for help on using the repository browser.