| 1 | IBPUBUL ;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
|
|---|
