IBPUBUL ;ALB/CPM - ARCHIVE/PURGING BULLETIN ; 20-APR-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; Input: IBD (file) = piece 1: date through which to archive/purge
; piece 2: old log # to cancel
; piece 3: new log # created
; piece 4: error message
; IBOP = 1 - Search, 2 - Archiving, 3 - Purging
; DUZ = User ID
;
; - set up MailMan's variables
S XMSUB="INTEGRATED BILLING "_$P("SEARCH^ARCHIVING^PURGING","^",IBOP)_" OF BILLING DATA"
S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
K XMY S XMY(DUZ)=""
;
; - build report header
K IBT S IBT(1)="The subject job has yielded the following results:"
S IBHDR="Search ^Archive^ Purge "
S IBT(2)=$J("",37)_$P(IBHDR,"^",IBOP)_$J("",11)_$P(IBHDR,"^",IBOP)_$J("",7)_"# Records"
S IBT(3)="File"_$J("",23)_"Log# Begin Date/Time End Date/Time "_$P(" Found^Archived^ Purged","^",IBOP)
S $P(IBT(4),"-",79)=""
;
; - write detail lines
S IBC=4,IBFILE=0 F S IBFILE=$O(IBD(IBFILE)) Q:'IBFILE S IBDAT=IBD(IBFILE) D
. S IBFILEN=$S($D(^DIC(IBFILE,0))#2:$P(^(0),"^"),1:"* UNKNOWN FILE *")
. S IBC=IBC+1,IBT(IBC)=IBFILEN_$J("",27-$L(IBFILEN))
. S IBT(IBC)=IBT(IBC)_$S($P(IBDAT,"^",3):$J($P(IBDAT,"^",3),4),1:" -- ")
. I $P(IBDAT,"^",4)]"" D Q
.. 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))_" **"
.. I $P(IBDAT,"^",3)]"" S IBC=IBC+1,IBT(IBC)=" Error: >> "_$P(IBDAT,"^",4)_" <<"
.. S IBC=IBC+1,IBT(IBC)=" "
. S IBLOG0=$G(^IBE(350.6,+$P(IBDAT,"^",3),0)),IBLOGT=$G(^(IBOP))
. 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 ")
. S IBT(IBC)=IBT(IBC)_" "_$J($P(IBLOG0,"^",4),5)
. S IBC=IBC+1,IBT(IBC)=" "
;
; - deliver bulletin
D ^XMD
K IBC,IBDAT,IBFILE,IBFILEN,IBHDR,IBLOG0,IBLOGT,IBT,IBTIME,XMDUZ,XMSUB,XMTEXT,XMY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBPUBUL 2116 printed Sep 23, 2025@20:02:58 Page 2
IBPUBUL ;ALB/CPM - ARCHIVE/PURGING BULLETIN ; 20-APR-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; Input: IBD (file) = piece 1: date through which to archive/purge
+5 ; piece 2: old log # to cancel
+6 ; piece 3: new log # created
+7 ; piece 4: error message
+8 ; IBOP = 1 - Search, 2 - Archiving, 3 - Purging
+9 ; DUZ = User ID
+10 ;
+11 ; - set up MailMan's variables
+12 SET XMSUB="INTEGRATED BILLING "_$PIECE("SEARCH^ARCHIVING^PURGING","^",IBOP)_" OF BILLING DATA"
+13 SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET XMTEXT="IBT("
+14 KILL XMY
SET XMY(DUZ)=""
+15 ;
+16 ; - build report header
+17 KILL IBT
SET IBT(1)="The subject job has yielded the following results:"
+18 SET IBHDR="Search ^Archive^ Purge "
+19 SET IBT(2)=$JUSTIFY("",37)_$PIECE(IBHDR,"^",IBOP)_$JUSTIFY("",11)_$PIECE(IBHDR,"^",IBOP)_$JUSTIFY("",7)_"# Records"
+20 SET IBT(3)="File"_$JUSTIFY("",23)_"Log# Begin Date/Time End Date/Time "_$PIECE(" Found^Archived^ Purged","^",IBOP)
+21 SET $PIECE(IBT(4),"-",79)=""
+22 ;
+23 ; - write detail lines
+24 SET IBC=4
SET IBFILE=0
FOR
SET IBFILE=$ORDER(IBD(IBFILE))
if 'IBFILE
QUIT
SET IBDAT=IBD(IBFILE)
Begin DoDot:1
+25 SET IBFILEN=$SELECT($DATA(^DIC(IBFILE,0))#2:$PIECE(^(0),"^"),1:"* UNKNOWN FILE *")
+26 SET IBC=IBC+1
SET IBT(IBC)=IBFILEN_$JUSTIFY("",27-$LENGTH(IBFILEN))
+27 SET IBT(IBC)=IBT(IBC)_$SELECT($PIECE(IBDAT,"^",3):$JUSTIFY($PIECE(IBDAT,"^",3),4),1:" -- ")
+28 IF $PIECE(IBDAT,"^",4)]""
Begin DoDot:2
+29 SET IBT(IBC)=IBT(IBC)_" ** "_$SELECT($PIECE(IBDAT,"^",3):"LOG ENTRY HAS BEEN CANCELLED",$PIECE(IBDAT,"^",3)=0:"LOG ENTRY WAS NOT CREATED",1:$PIECE(IBDAT,"^",4))_" **"
+30 IF $PIECE(IBDAT,"^",3)]""
SET IBC=IBC+1
SET IBT(IBC)=" Error: >> "_$PIECE(IBDAT,"^",4)_" <<"
+31 SET IBC=IBC+1
SET IBT(IBC)=" "
End DoDot:2
QUIT
+32 SET IBLOG0=$GET(^IBE(350.6,+$PIECE(IBDAT,"^",3),0))
SET IBLOGT=$GET(^(IBOP))
+33 FOR I=1,2
SET IBTIME=$PIECE(IBLOGT,"^",I)
SET IBT(IBC)=IBT(IBC)_" "_$SELECT(IBTIME:$$DAT1^IBOUTL(IBTIME)_"@"_$PIECE($$DAT2^IBOUTL(IBTIME),"@",2),1:"Not specified ")
+34 SET IBT(IBC)=IBT(IBC)_" "_$JUSTIFY($PIECE(IBLOG0,"^",4),5)
+35 SET IBC=IBC+1
SET IBT(IBC)=" "
End DoDot:1
+36 ;
+37 ; - deliver bulletin
+38 DO ^XMD
+39 KILL IBC,IBDAT,IBFILE,IBFILEN,IBHDR,IBLOG0,IBLOGT,IBT,IBTIME,XMDUZ,XMSUB,XMTEXT,XMY
+40 QUIT
