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

IBCEFG7.m

Go to the documentation of this file.
  1. IBCEFG7 ;ALB/TMP - OUTPUT FORMATTER GENERIC FORM PROCESSING ;06-MAR-96
  1. ;;2.0;INTEGRATED BILLING;**52,84,96,51,137,191,320,608,641**;21-MAR-94;Build 61
  1. ;;Per VA Directive 6402, this routine should not be modified
  1. Q
  1. ;
  1. ;/IB*2*608 (vd) - US2486 added the parameter IBRSBTST to indicate a claim is a "TEST"
  1. ; that is being RESUBMITTED and assists with the COB Output Formatter data.
  1. FORM(IBFORM,IBQUE,IBNOASK,IBQDT,ZTSK,IBABORT,IBRSBTST) ;For ien IBFORM, extract data using
  1. ; output generater
  1. ; IBQUE = the output queue for transmitted forms or the printer queue
  1. ; for printed output
  1. ; IBNOASK = flag that says user interaction for queuing is not needed
  1. ; 0 or null = ask, 1 = don't ask
  1. ; IBQDT = the date/time to queue the job (optional)
  1. ;
  1. ; Sets ZTSK only if job is queued
  1. ;
  1. ; IBABORT = output parameter which says user aborted forms output.
  1. ; Pass by reference. The $$QUEUE function returned false.
  1. ;
  1. ; IBRSBTST = 1, this indicates the claim is being resubmitted as a "TEST" claim and should be
  1. ; used by the OUTPUT FORMATTER entries to determine what COB information is
  1. ; going out. - IB*2.0*608 (vd) US2486
  1. ;
  1. N IBF2,IBTYP,POP,ZTIO,ZTRTN,ZTDESC,ZTSAVE,ZTREQ,ZTDTH,ZTREQ
  1. S IBTYP=$P($G(^IBE(353,IBFORM,2)),U,2),IBQUE=$G(IBQUE),IBABORT=0
  1. G:$S(IBTYP'="S":$G(^IBE(353,IBFORM,"EXT"))=""&($G(^IBE(353,+$P($G(^IBE(353,IBFORM,2)),U,5),"EXT"))=""),1:'$G(IBIFN)) FORMQ
  1. ;I IBTYP="P",IBQUE="" D DEV(IBFORM) G:$G(POP) FORMQ ;WCJ;US3380
  1. I IBTYP="P",IBQUE="" D DEV(IBFORM,,.IBABORT) G:$G(POP) FORMQ ;WCJ;US3380
  1. I IBTYP="T" D:$G(IBNOASK) Q:$G(IBNOASK) I '$$QUEUE(IBFORM) S:$O(^TMP("IBRESUBMIT",$J,0)) ^TMP("IBRESUBMIT",$J)="ABORT" S IBABORT=1 Q
  1. . S ZTRTN="FORMOUT^IBCEFG7",ZTIO="",ZTDESC="OUTPUT FORMATTER - FORM: "_$P($G(^IBE(353,IBFORM,0)),U),ZTSAVE("IB*")="",ZTDTH=$S($G(IBQDT):IBQDT,1:$$NOW^XLFDT())
  1. . S:$D(^TMP("IBRESUBMIT",$J)) ZTSAVE("^TMP(""IBRESUBMIT"",$J)")="",ZTSAVE("^TMP(""IBNOT"",$J)")="",ZTSAVE("^TMP(""IBRESUBMIT"",$J,")="",ZTSAVE("^TMP(""IBNOT"",$J,")=""
  1. . I $D(^TMP("IBSELX",$J)) S ZTSAVE("^TMP(""IBSELX"",$J,")="",ZTSAVE("^TMP(""IBSELX"",$J)")=""
  1. . S:'$G(DUZ) DUZ=.5
  1. . D ^%ZTLOAD
  1. I '$G(ZTSK) D FORMOUT
  1. FORMQ Q
  1. ;
  1. FORMOUT ; Queued job entrypoint - IBFORM needs to be defined
  1. ; IBQUE needs to be defined if using default transmission output
  1. N IB2,IBTYP,IBPAR
  1. K ^TMP("IBXDATA",$J)
  1. S ZTREQ="@"
  1. S IB2=$G(^IBE(353,IBFORM,2)),IBPAR=+$P(IB2,U,5),IBTYP=$P(IB2,U,2)
  1. ;
  1. ; Execute PRE-PROCESSOR
  1. I IBTYP'="S" D FPRE(IBFORM,IBPAR,.IBXERR)
  1. G:$G(IBXERR)'="" FOUTQ
  1. ;
  1. ; Extract records - this should include call(s) to $$EXTRACT^IBCEFG()
  1. I IBTYP'="S" D
  1. .I $G(^IBE(353,IBFORM,"EXT"))'="" X ^("EXT") ;Form extract
  1. .I $G(^IBE(353,IBFORM,"EXT"))="",$G(^IBE(353,IBPAR,"EXT"))'="" X ^("EXT") ;Parent form extract
  1. I IBTYP="S" D G Q1
  1. .N PARAM,Z,Z0
  1. .S PARAM(1)="BILL-SEARCH",Z0=$G(^DGCR(399,IBIFN,0))
  1. .S Z=$P(Z0,U,21) S:Z="" Z="P" S PARAM(2)=$P($G(^DGCR(399,IBIFN,"I"_($F("PST",Z)-1))),U),PARAM(3)=$S($P(Z0,U,5)<3:"I",1:"O")
  1. .S Z=$$EXTRACT^IBCEFG(IBFORM,IBIFN,1,.PARAM)
  1. ;
  1. G:'$D(^TMP("IBXDATA",$J)) FOUTQ
  1. ;
  1. ; If an output routine exists, use it, otherwise use the generic ones
  1. I $G(^IBE(353,IBFORM,"OUT"))'="" X ^("OUT") G FOUTQ
  1. I $G(^IBE(353,IBFORM,"OUT"))="",$G(^IBE(353,IBPAR,"OUT"))'="" X ^("OUT") G FOUTQ
  1. ;
  1. I IBTYP="P" D PRINT(IBFORM) D:'$D(ZTQUEUED) ^%ZISC G FOUTQ
  1. I IBTYP="T" D:$G(IBQUE)'="" TRANSMIT(IBFORM,IBQUE) G FOUTQ
  1. ;
  1. FOUTQ D FPOST(IBFORM,IBPAR,.IBXERR) ; Execute POST-PROCESSOR, if any
  1. K ^TMP("IBXDATA",$J),^TMP("IBXEDIT",$J)
  1. Q1 Q
  1. ;
  1. PRINT(IBFORM) ; Print data from extract global for form IBFORM
  1. ; Extract records - this should include call(s) to $$EXTRACT^IBCEFG()
  1. N IB1,IB2,IB3,IBREC
  1. ;LOOP THROUGH RECORD/PAGE/LINE/COL
  1. S IBREC="" F S IBREC=$O(^TMP("IBXDATA",$J,IBREC)) Q:IBREC="" D ;Rec
  1. . ;Page/line
  1. . F IB1=1:1:+$O(^TMP("IBXDATA",$J,IBREC,""),-1) W:IB1>1 @IOF W ?0 F IB2=1:1:+$O(^TMP("IBXDATA",$J,IBREC,IB1,""),-1) W:IB2>1 ! S IB3="" D
  1. .. ; Column
  1. .. F S IB3=$O(^TMP("IBXDATA",$J,IBREC,IB1,IB2,IB3)) Q:IB3="" W ?(IB3-1),^(IB3)
  1. . ;Only print form feed if more records to print - not on last record
  1. . I $O(^TMP("IBXDATA",$J,IBREC))'="" W @IOF
  1. Q
  1. ;
  1. TRANSMIT(IBFORM,IBQUE) ; Send data from extract global to queue IBQUE
  1. ;IBFORM = ien of the form to be transmitted (required)
  1. N IB1,IB2,IB3,IBREC,IBOUT,IBCT,IBSUB,Z,XMDUZ,XMSUBJ,XMBODY,XMTO
  1. K ^TMP("IBXTXMT",$J),^TMP("IBX",$J)
  1. Q:$G(IBQUE)=""
  1. ;
  1. S IBDELIM=$P($G(^IBE(353,+$S($P($G(^IBE(353,IBFORM,2)),U,5):$P(^(2),U,5),1:IBFORM),2)),U,7)
  1. S:IBDELIM="" IBDELIM="^"
  1. ;Loop through record/page/line/column
  1. S IBREC="",(IBSIZE,IBCT)=0,IBMSG=1
  1. F S IBREC=$O(^TMP("IBXDATA",$J,IBREC)) Q:IBREC="" D
  1. .S ^TMP("IBX",$J,IBREC)=IBCT
  1. .S IB1="" F S IB1=$O(^TMP("IBXDATA",$J,IBREC,IB1)) Q:IB1="" D
  1. ..S (IB2,IBOUT)=""
  1. ..F S IB2=$O(^TMP("IBXDATA",$J,IBREC,IB1,IB2)) D:IB2=""&$L(IBOUT) MSG(IBREC,IBOUT,.IBMSG,.IBSIZE,.IBCT) Q:IB2="" D
  1. ...S IB3="" F S IB3=$O(^TMP("IBXDATA",$J,IBREC,IB1,IB2,IB3)) Q:IB3="" S IBP=^(IB3) S:IBP?.E1L.E IBP=$$UP^XLFSTR(IBP) S $P(IBOUT,IBDELIM,IB3)=IBP
  1. ;
  1. ;Send mail message(s) for extract
  1. S XMDUZ=DUZ,XMTO(IBQUE)="",IBSUB="OUTPUT FORMATTER: "_$P($G(^IBE(353,IBFORM,0)),U)
  1. S Z="" F S Z=$O(^TMP("IBXTXMT",$J,Z)) Q:'Z S XMBODY="^TMP(""IBXTXMT"","_$J_","_Z_")",XMSUBJ=IBSUB_" ("_Z_")" D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
  1. ;
  1. K ^TMP("IBXTXMT",$J),^TMP("IBX",$J)
  1. Q
  1. ;
  1. MSG(IBREC,LINE,MSG,SIZE,CT) ; Set up global for transmission line
  1. ; IBREC = record number being processed
  1. ; LINE = actual text to be output in mail message line
  1. ; MSG = the message seq # to output this record in (pass by reference)
  1. ; SIZE = current size of the message (pass by reference)
  1. ; CT = the last line # in message for the text (pass by reference)
  1. N Z,Z0,LLEN
  1. S LLEN=$L(LINE)
  1. I (LLEN+SIZE)>30000 D
  1. .Q:'$G(^TMP("IBX",$J,IBREC)) ;Record itself is > 30000 - let it go
  1. .S (SIZE,CT)=0,Z=$G(^TMP("IBX",$J,IBREC)),^(IBREC)=0
  1. .F S Z=$O(^TMP("IBXTXMT",$J,MSG,Z)) Q:'Z S CT=CT+1,Z0=^(Z),^TMP("IBXTXMT",$J,MSG+1,CT)=Z0,SIZE=SIZE+$L(Z0) K ^TMP("IBXTXMT",$J,MSG,Z)
  1. .S MSG=MSG+1
  1. S CT=CT+1,^TMP("IBXTXMT",$J,MSG,CT)=LINE,SIZE=SIZE+LLEN
  1. Q
  1. ;
  1. DEV(IBFORM,NOQ,IBABORT) ;WCJ;US3380 added IBABORT
  1. N IBFTYPE
  1. S:'$G(NOQ) %ZIS="Q" S %ZIS("A")="Output Device: "
  1. S %ZIS("B")=$P($G(^IBE(353,IBFORM,0)),"^",2)
  1. D ^%ZIS
  1. ;G:POP DEVQ;WCJ;US3880
  1. I POP S IBABORT=1 G DEVQ ;WCJ;US3880
  1. I $D(IO("Q")) D G DEVQ
  1. .S ZTRTN="FORMOUT^IBCEFG7",ZTDESC="PRINT FORM: "_$P($G(^IBE(353,IBFORM,0)),U),ZTSAVE("IB*")="" K ZTIO
  1. .I $D(^TMP("IBQONE",$J)) D
  1. ..S IBJ="",IBFTYPE="IBCFP"_$S($P($G(^IBE(353,IBFORM,2)),U,5):$P(^(2),U,5),1:IBFORM)
  1. ..S ZTSAVE("^XTMP(IBFTYPE,$J,")=""
  1. .D ^%ZTLOAD K IO("Q") D HOME^%ZIS
  1. .I $G(IBFTYPE)'="" K ^XTMP(IBFTYPE,$J)
  1. .I '$D(ZTSK) S (POP,IBABORT)=1 ;WCJ;US3880;IB641V13
  1. .I $D(ZTSK) W !!,"This job has been queued. The task number is "_ZTSK_"."
  1. U IO
  1. DEVQ Q
  1. ;
  1. QUEUE(IBFORM) ; Ask to queue transmission
  1. N Y,DIR,OKAY
  1. S OKAY=1
  1. S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to queue this transmission" W !
  1. D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT) S OKAY=0 G QUEQ
  1. I 'Y D G QUEQ
  1. .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to run this job without queuing it now"
  1. .W ! D ^DIR K DIR
  1. .I 'Y S OKAY=0
  1. ; - queue job to run
  1. W !!,"Please enter the date and time to execute this job...",!
  1. S ZTRTN="FORMOUT^IBCEFG7",ZTIO="",ZTDESC="OUTPUT FORMATTER - FORM: "_$P($G(^IBE(353,IBFORM,0)),U),ZTSAVE("IB*")=""
  1. S:$D(^TMP("IBRESUBMIT",$J)) ZTSAVE("^TMP(""IBRESUBMIT"",$J)")="",ZTSAVE("^TMP(""IBNOT"",$J)")="",ZTSAVE("^TMP(""IBRESUBMIT"",$J,")="",ZTSAVE("^TMP(""IBNOT"",$J,")=""
  1. I $D(^TMP("IBSELX",$J)) S ZTSAVE("^TMP(""IBSELX"",$J,")="",ZTSAVE("^TMP(""IBSELX"",$J)")=""
  1. D ^%ZTLOAD
  1. I $G(ZTSK) W !!,"This job has been queued. The task number is "_ZTSK_"."
  1. QUEQ Q OKAY
  1. ;
  1. FPRE(IBFORM,IBPAR,IBXERR) ; Executes pre-processor
  1. I $G(^IBE(353,IBFORM,"FPRE"))'="" X ^("FPRE") ;Form pre-processor
  1. I $G(^IBE(353,IBFORM,"FPRE"))="",$G(^IBE(353,IBPAR,"FPRE"))'="" X ^("FPRE") ;Parent form pre-processor
  1. Q
  1. ;
  1. FPOST(IBFORM,IBPAR,IBXERR) ; Executes post-processor
  1. I $G(^IBE(353,IBFORM,"FPOST"))'="" X ^("FPOST") ;Form post-processor
  1. I $G(^IBE(353,IBFORM,"FPOST"))="",$G(^IBE(353,IBPAR,"FPOST"))'="" X ^("FPOST") ;Parent form post-processor
  1. Q
  1. ;
  1. FMFLD(IBDA) ;Return the file#field for fileman field referenced as a data
  1. ; element in file 364.7's IBDA entry.
  1. N Z,Z0,ND0
  1. S Z0=+$P($G(^IBA(364.7,IBDA,0)),U,3),ND0=$G(^IBA(364.5,+Z0,0))
  1. I $P(ND0,U,3)'="F"!($P(ND0,U,6)="") S Z="" G FLDQ
  1. S Z=$P(ND0,U,5),Z1=$P(ND0,U,6)
  1. I Z1[":" D ;Navigation
  1. . S Z2=$O(^DD(+Z,"B",$P(Z1,":"),"")) Q:'Z2
  1. . S Z=+$P($P($G(^DD(399,Z2,0)),U,2),"P",2)
  1. . I Z S Z1=$P(Z1,":",2)
  1. I Z S Z=Z_"#"_$O(^DD(+Z,"B",Z1,""))
  1. FLDQ Q Z
  1. ;