source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBP.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: 2.4 KB
Line 
1IBP ;ALB/CPM - ARCHIVE/PURGING OPERATIONS ; 17-APR-92
2 ;;2.0;INTEGRATED BILLING;**153**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5FIND ; Entry point to Find Billing Data to Archive
6 S IBOP=1 G START
7 ;
8ARCHIVE ; Entry point to Archive Billing Data
9 S IBOP=2 G START
10 ;
11PURGE ; Entry point to Purge Billing Data
12 S IBOP=3
13 ;
14 ;
15START ; Begin search/archive/purge operations.
16 I $$NODUZ^IBPU1 G END ; no DUZ code
17 I IBOP>1,$$NOESIG^IBPU1(DUZ) G END ; no Electronic Signature Code
18 S IBLINE="",$P(IBLINE,"-",80)=""
19 ;
20 ; - write header
21 D HOME^%ZIS
22 S IBHDR="*** "_$P("Find^Archive^Purge","^",IBOP)_" Billing Data"_$S(IBOP=1:" to Archive",1:"")_" ***"
23 W @IOF,!?80-$L(IBHDR)\2,IBHDR,!
24 W !,"This option is used to ",$P("begin the archive process for^archive data from^purge data from","^",IBOP)," the following files:",!
25 W !?8,"#350 INTEGRATED BILLING ACTION",!?8,"#351 MEANS TEST BILLING CLOCK",!?8,"#399 BILL/CLAIMS",!!
26 I IBOP=1 W "Specify your search criteria for each file. "
27 W "The ",$P("search^archiving process^purge process","^",IBOP)," will be queued.",!
28 ;
29 ; - issue all operational prompts
30 K IBD
31 F I=350,351,399 W !,IBLINE S J=$$ASK^IBPU(I,IBOP) G:J<0 END I J S IBD(I)="" I IBOP=1 S K=$$DAT^IBPU G:K<0 END S IBD(I)=K_"^"_+$P(J,"^",2)
32 I '$D(IBD) X "F I=$Y:1:(IOSL-3) W !" S DIR(0)="E" D ^DIR K DIR G END
33 ;
34 ; - select device if archiving
35 I IBOP=2 S %ZIS="N",%ZIS("B")="",%ZIS("A")="Archive entries to what device: " D ^%ZIS G:POP END
36 ;
37 ; - must enter Electronic Signature to archive or purge
38 I IBOP>1,'$$ESIG^IBPU1(DUZ) G END
39 ;
40 ; - if ok to continue, task off job
41 I $$OKAY^IBPU1(IBOP) D TASK^IBPU1
42 ;
43END ; - clean up and quit
44 D HOME^%ZIS
45 K I,IBD,IBHDR,IBLINE,IBOP,J,K,Y
46 Q
47 ;
48 ;
49 ;
50QUE ; Tasked Entry point to begin search/archive/purge operations.
51 ;
52 ; Input: IBD(file number) -- piece 1: date through which to archive
53 ; piece 2: log entry if restarting
54 ; IBOP -- 1 (Search), 2 (Archive), 3 (Purge)
55 ; DUZ -- user ID; retained by Taskman
56 ;
57 ; - perform operation on each requested file
58 S IBF="" F S IBF=$O(IBD(IBF)) Q:'IBF D @("^IBP"_$P("F^A^P","^",IBOP))
59 ;
60 ; - send confirmation message to user
61 D ^IBPUBUL
62 ;
63 ; - clean up and quit
64 K DFN,DATE,IBBDT,IBCNT,IBD,IBDATA,IBEDT,IBF,IBFNAME,IBHDT,IBLINE,IBLOG,IBN,IBOFF,IBOP,IBPAGE,IBROOT,IBSTAT,IBTMDA,IBTMPL,IBRCNO
65 Q
Note: See TracBrowser for help on using the repository browser.