IBPUBUL.m

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

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