Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCFP1

IBCFP1.m

Go to the documentation of this file.
  1. IBCFP1 ;ALB/ARH - PRINT AUTHORIZED BILLS IN ORDER ;6-DEC-94
  1. ;;2.0;INTEGRATED BILLING;**54,52,80,121,51,137,155,320,348,349,718**;21-MAR-94;Build 73
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;
  1. QTASK ; 1st part sorts authorized bills into order requested by bill form type then queues off 1 job for each type to print bills
  1. ;
  1. D GCLEAN S IBXP=$$FMADD^XLFDT(DT,1)_"^"_DT_"^BATCH PRINT BILLS "_$$HTE^XLFDT($H)_" by "_$S($D(^VA(200,+$G(DUZ),0)):$P(^(0),"^"),1:"Unknown User")
  1. SORT ;sort authorized bills by form type and requested sort order (notice bill addendums only print for 1500's)
  1. S (IBQ,IBIFN)=0 F S IBIFN=$O(^DGCR(399,"AST",3,IBIFN)) Q:'IBIFN!IBQ D I $$STOP S IBQ=1 Q
  1. . Q:+$$TXMT^IBCEF4(IBIFN)=1 ;Exclude transmittable bills
  1. . S IBFT=$$FT^IBCU3(IBIFN) Q:$P($G(^IBE(353,+IBFT,0)),U,2)="" I IBFT'?1N Q ;No device for form type
  1. . S IBX=$G(^DGCR(399,IBIFN,0)),IBPAT=$P($G(^DPT(+$P(IBX,U,2),0)),U,1) Q:$P(IBX,U,13)'=3
  1. . S IBZIP=$P($G(^DGCR(399,IBIFN,"M")),U,9),IBINS=$P($G(^DIC(36,+$G(^DGCR(399,IBIFN,"MP")),0)),U,1)
  1. . S IBX=IBZIP_U_IBINS_U_IBPAT,IBS1=$P(IBX,U,$E(IBS,1))_" ",IBS2=$P(IBX,U,$E(IBS,2))_" ",IBS3=$P(IBX,U,$E(IBS,3))_" "
  1. . S ^XTMP("IBCFP"_IBFT,0)=IBXP,^XTMP("IBCFP"_IBFT,$J,IBS1,IBS2,IBS3,IBIFN)=""
  1. . S XIBFT=IBFT ;save off curent value of IBFT
  1. . ;
  1. . ; set MRA queue to print
  1. . S IBFT=$$FNT^IBCU3("MRA")
  1. . ; Merge the data from ^XTMP("IBCFP" queue, into "IBMRA" queue
  1. . I +IBFT,$P($G(^IBE(353,+IBFT,0)),U,2)'="" S ^XTMP("IBMRA"_IBFT,0)=IBXP M ^XTMP("IBMRA"_IBFT,$J)=^XTMP("IBCFP"_XIBFT,$J)
  1. . ;
  1. . ; Print Bill Addendums only for 1500's
  1. . I $$FTN^IBCU3(XIBFT)'["CMS-1500" Q
  1. . S IBFT=$$FNT^IBCU3("BILL ADDENDUM")
  1. . I +IBFT,$P($G(^IBE(353,+IBFT,0)),U,2)'="" S ^XTMP("IBCFP"_IBFT,0)=IBXP,^XTMP("IBCFP"_IBFT,$J,IBS1,IBS2,IBS3,IBIFN)=""
  1. . Q
  1. K IBIFN,IBFT,XIBFT,IBX,IBY,IBPAT,IBZIP,IBINS,IBS1,IBS2,IBS3,IBS,IBXP
  1. ;
  1. QUEUE ; starts a queued job for each form type that an authorized bill was found for
  1. ; no form types without defined device
  1. I IBQ D GCLEAN ;queued job stopped
  1. I 'IBQ D
  1. . ; queue a job for each form type
  1. . S IBIX="IBCFP" F S IBIX=$O(^XTMP(IBIX)) Q:(IBIX'?1"IBCFP"1N) I $D(^XTMP(IBIX,$J)) S IBFT=$E(IBIX,6) D
  1. . . S ZTIO=$P($G(^IBE(353,+IBFT,0)),U,2),IBFTP=IBIX,IBJ=$J
  1. . . S ZTDTH=$H,ZTSAVE("IBFTP")="",ZTSAVE("IBFT")="",ZTSAVE("IBJ")=""
  1. . . S ZTDESC="BATCH PRINTING "_$$FTN^IBCU3(+IBFT),ZTRTN="QBILL^IBCFP1" D ^%ZTLOAD
  1. . ; Also queue a job to print MRA's, if any, for each bill
  1. . S IBIX="IBMRA" F S IBIX=$O(^XTMP(IBIX)) Q:(IBIX'?1"IBMRA"1N) I $D(^XTMP(IBIX,$J)) S IBFT=$E(IBIX,6) D
  1. . . S ZTIO=$P($G(^IBE(353,+IBFT,0)),U,2),IBFTP=IBIX,IBJ=$J
  1. . . S ZTDTH=$H,ZTSAVE("IBFTP")="",ZTSAVE("IBFT")="",ZTSAVE("IBJ")=""
  1. . . S ZTDESC="BATCH PRINTING MRA'S",ZTRTN="QMRA^IBCEMU2" D ^%ZTLOAD
  1. K IBIX,IBY,IBFTP,IBJ ; end of first queued part
  1. Q
  1. ;
  1. GCLEAN ; Clean up XTMP global for $J of IBCFP and IBMRA entries
  1. N I
  1. S I="IBCFP" F S I=$O(^XTMP(I)) Q:I'?1"IBCFP"1N.N K ^XTMP(I)
  1. S I="IBMRA" F S I=$O(^XTMP(I)) Q:I'?1"IBMRA"1N.N K ^XTMP(I)
  1. Q
  1. ;
  1. QBILL ; 2nd queued part will print all authorized bills for a specific form type
  1. N IBF,IBFORM,IBPNT
  1. S IBF=$P($G(^IBE(353,+IBFT,2)),U,8),IBPNT=1
  1. I $D(IBMCSPNT) S IBPNT=IBMCSPNT ; IB*320 - MCS resubmit by print
  1. I IBF'="" S IBFORM=IBF D FORMOUT^IBCEFG7 Q ;call formatter
  1. ;
  1. QB1 ; Entrypoint for output logic of formatter
  1. ; pass in "^XTMP(IBFTP,IBJ)" sorted array of bills to print
  1. ; IBFTP = "IBCFP"_(form type) subscript indicating which part of array to print
  1. ; IBPNT = reprint status of bill (1-original, 0-copy, etc)
  1. ; IBFT = IFN of bill form type to be printed
  1. ; IBJ = $J of starting job (for when multiple print jobs might be queued)
  1. ; if a single bill printed and queued, IBJ will be null
  1. S:$G(IBJ)="" IBJ=$J
  1. S:'$D(IBPNT) IBPNT=1
  1. N IBCT,IBBN,IBS1,IBS2,IBS3,IBQ,IBIFN
  1. S (IBCT,IBQ,IBS1)=0
  1. S ZTREQ="@"
  1. F S IBS1=$O(^XTMP(IBFTP,IBJ,IBS1)) Q:IBS1=""!IBQ D
  1. . S IBS2=0 F S IBS2=$O(^XTMP(IBFTP,IBJ,IBS1,IBS2)) Q:IBS2=""!IBQ D
  1. .. S IBS3=0 F S IBS3=$O(^XTMP(IBFTP,IBJ,IBS1,IBS2,IBS3)) Q:IBS3=""!IBQ D
  1. ... S IBBN=0 F S IBBN=$O(^XTMP(IBFTP,IBJ,IBS1,IBS2,IBS3,IBBN)) Q:IBBN="" D I $$STOP S IBQ=1 Q
  1. .... D ROUT(IBFT,IBPNT,IBBN,.IBCT)
  1. K ^XTMP(IBFTP,IBJ) ; end of last queued part
  1. Q
  1. ;
  1. ;WCJ;IB718v22;adding a parameter to execute FSC workarounds in the post processing routine/s)
  1. ;ROUT(IBFT,IBPNT,IBIFN,IBCT,IBF,IBXPOSTWA) ; sub procedure to protect variables with new
  1. ROUT(IBFT,IBPNT,IBIFN,IBCT,IBF,IBXPOSTWA) ; sub procedure to protect variables with new
  1. ; IBXPOSTWA = 1 if executing FSC post processing workarounds ;WCJ;IB718v22;
  1. N IBBN,IBS1,IBS2,IBS3,IBQ,IBFTP,IBJ,IBXPARM,Z
  1. D BILLPARM^IBCEFG0(IBIFN,.IBXPARM)
  1. S IBF=$S($G(IBF)'="":IBF,1:$P($G(^IBE(353,+IBFT,2)),U,8))
  1. S IBCT=$G(IBCT)+1
  1. ;
  1. ; IBF exists - use the Output Formatter for printing
  1. ; 2.08 field in file 353 - PRINT FORM NAME
  1. ;WCJ;IB718v22;adding a parameter to execute FSC workarounds in the post processing routine/s)
  1. ;I IBF'="" S Z=$$EXTRACT^IBCEFG(IBF,IBIFN,.IBCT,.IBXPARM) G REX
  1. I IBF'="" S Z=$$EXTRACT^IBCEFG(IBF,IBIFN,.IBCT,.IBXPARM,$G(IBXPOSTWA)) G REX
  1. ;
  1. ; IBF does not exist - Obsolete VistA extract/print routines
  1. I IBFT=1 S DFN=$P($G(^DGCR(399,+IBIFN,0)),U,2) D ENP^IBCF1 W @IOF G REX
  1. I $$FTN^IBCU3(+IBFT)="HCFA 1500" D EN^IBCF2 W @IOF G REX
  1. I $$FTN^IBCU3(+IBFT)="UB-92" D EN^IBCF3 W @IOF G REX
  1. ;
  1. ; print bill addendums
  1. I $$FTN^IBCU3(+IBFT)="BILL ADDENDUM" I +$$BILLAD^IBCF4(IBIFN) D EN^IBCF4 W @IOF G REX
  1. ;
  1. REX Q
  1. ;
  1. DATE(X) Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
  1. ;
  1. STOP() ;determine if user has requested the queued report to stop
  1. I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !,"***TASK STOPPED BY USER***"
  1. Q +$G(ZTSTOP)
  1. ;
  1. FORMPRE ; Set up environment for bill message
  1. K ^TMP("IBXMSG",$J),^TMP("IBXERR",$J),IBXERR,^TMP("IBXDATA",$J)
  1. Q
  1. ;
  1. FORMPOST ; Clean up
  1. I $O(^TMP("IBXERR",$J,"")) D ;Error messages to mail group
  1. .N XMTO,XMBODY,XMDUZ,XMSUBJ,IBCT,IBERR
  1. .K ^TMP("IBXMSG",$J)
  1. .S ^TMP("IBXMSG",$J,1)="The following bill(s) were not printed due to errors indicated.",^(2)="Once the errors are corrected, the bill(s) can be printed again.",^(3)=" "
  1. .;
  1. .S IBERR=0,IBCT=3
  1. .F S IBERR=$O(^TMP("IBXERR",$J,IBERR)) Q:'IBERR S IBCT=IBCT+1,^TMP("IBXMSG",$J,IBCT)="Bill #: "_$P($G(^DGCR(399,IBERR,0)),U),IBCT=IBCT+1,^TMP("IBXMSG",$J,IBCT)=$J("",5)_^TMP("IBXERR",$J,IBERR)
  1. .S XMBODY="^TMP(""IBXMSG"","_$J_")" D ERRMSG(XMBODY)
  1. .K ^TMP("IBXMSG",$J),^TMP($J,"IBICT")
  1. ;
  1. K ^TMP("IBXERR",$J),IBXERR
  1. D CLEAN^DILF
  1. Q
  1. ;
  1. ENTPRE ; Run before processing a bill entry
  1. K IBXSAVE,IBXERR,^UTILITY("VAPA",$J),^TMP("IBXSAVE",$J),^TMP($J),^TMP("DIERR",$J)
  1. Q
  1. ;
  1. ENTPOST ; Run after processing a bill entry
  1. N IBIFN
  1. I $G(IBXERR)'="" S ^TMP("IBXERR",$J,IBXIEN)=IBXERR K ^TMP("IBXDATA",$J)
  1. S IBIFN=IBXIEN D END^IBCF2
  1. K IBXSAVE,^UTILITY("VAPA",$J),^TMP($J),^TMP("IBXSAVE",$J)
  1. D CLEAN^DILF
  1. Q
  1. ;
  1. ERRMSG(XMBODY) ; Send bulletin for error message
  1. N XMTO,XMSUBJ
  1. S XMTO($G(DUZ))="",XMSUBJ="PRINT BILL ERRORS"
  1. ;
  1. D SENDMSG^XMXAPI(,XMSUBJ,XMBODY,.XMTO)
  1. D ALERT("One or more bills were not printed. Check your mail for details",$G(DUZ))
  1. Q
  1. ;
  1. ALERT(XQAMSG,IBGRP) ; Send alert message
  1. N XQA
  1. S XQA(IBGRP)=""
  1. D SETUP^XQALERT
  1. Q