source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBPUBUL.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.0 KB
Line 
1IBPUBUL ;ALB/CPM - ARCHIVE/PURGING BULLETIN ; 20-APR-92
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Input: IBD (file) = piece 1: date through which to archive/purge
6 ; piece 2: old log # to cancel
7 ; piece 3: new log # created
8 ; piece 4: error message
9 ; IBOP = 1 - Search, 2 - Archiving, 3 - Purging
10 ; DUZ = User ID
11 ;
12 ; - set up MailMan's variables
13 S XMSUB="INTEGRATED BILLING "_$P("SEARCH^ARCHIVING^PURGING","^",IBOP)_" OF BILLING DATA"
14 S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
15 K XMY S XMY(DUZ)=""
16 ;
17 ; - build report header
18 K IBT S IBT(1)="The subject job has yielded the following results:"
19 S IBHDR="Search ^Archive^ Purge "
20 S IBT(2)=$J("",37)_$P(IBHDR,"^",IBOP)_$J("",11)_$P(IBHDR,"^",IBOP)_$J("",7)_"# Records"
21 S IBT(3)="File"_$J("",23)_"Log# Begin Date/Time End Date/Time "_$P(" Found^Archived^ Purged","^",IBOP)
22 S $P(IBT(4),"-",79)=""
23 ;
24 ; - write detail lines
25 S IBC=4,IBFILE=0 F S IBFILE=$O(IBD(IBFILE)) Q:'IBFILE S IBDAT=IBD(IBFILE) D
26 . S IBFILEN=$S($D(^DIC(IBFILE,0))#2:$P(^(0),"^"),1:"* UNKNOWN FILE *")
27 . S IBC=IBC+1,IBT(IBC)=IBFILEN_$J("",27-$L(IBFILEN))
28 . S IBT(IBC)=IBT(IBC)_$S($P(IBDAT,"^",3):$J($P(IBDAT,"^",3),4),1:" -- ")
29 . I $P(IBDAT,"^",4)]"" D Q
30 .. S IBT(IBC)=IBT(IBC)_" ** "_$S($P(IBDAT,"^",3):"LOG ENTRY HAS BEEN CANCELLED",$P(IBDAT,"^",3)=0:"LOG ENTRY WAS NOT CREATED",1:$P(IBDAT,"^",4))_" **"
31 .. I $P(IBDAT,"^",3)]"" S IBC=IBC+1,IBT(IBC)=" Error: >> "_$P(IBDAT,"^",4)_" <<"
32 .. S IBC=IBC+1,IBT(IBC)=" "
33 . S IBLOG0=$G(^IBE(350.6,+$P(IBDAT,"^",3),0)),IBLOGT=$G(^(IBOP))
34 . F I=1,2 S IBTIME=$P(IBLOGT,"^",I),IBT(IBC)=IBT(IBC)_" "_$S(IBTIME:$$DAT1^IBOUTL(IBTIME)_"@"_$P($$DAT2^IBOUTL(IBTIME),"@",2),1:"Not specified ")
35 . S IBT(IBC)=IBT(IBC)_" "_$J($P(IBLOG0,"^",4),5)
36 . S IBC=IBC+1,IBT(IBC)=" "
37 ;
38 ; - deliver bulletin
39 D ^XMD
40 K IBC,IBDAT,IBFILE,IBFILEN,IBHDR,IBLOG0,IBLOGT,IBT,IBTIME,XMDUZ,XMSUB,XMTEXT,XMY
41 Q
Note: See TracBrowser for help on using the repository browser.