source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEFG8.m@ 808

Last change on this file since 808 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1IBCEFG8 ;ALB/TMP - OUTPUT FORMATTER GENERIC FORM TEST PROCESSING ;21-MAR-96
2 ;;2.0;INTEGRATED BILLING;**52,88,51,348**; 21-MAR-94;Build 5
3 ;
4 Q
5 ;
6TEST ;Select form from screen and entry from file to test
7 N IBF2,IBTYP,IBFORM,IBQUE,IB2,IBPAR,IBCEXDA,IBFILE,IBXERR,DIC,POP,Z,ZTSK,PARAMX,IBIFN,IBXIEN,Z0
8 ;Select form
9 D FULL^VALM1
10 D SELX^IBCEFG3 S IBFORM=$G(IBCEXDA)
11 G:IBFORM="" TESTQ
12 S IB2=$G(^IBE(353,IBFORM,2)),IBPAR=+$P(IB2,U,5)
13 ;
14 ; IB*2*348 - esg - no testing with old claim forms
15 I IBPAR=12!(IBPAR=13) D G TESTQ
16 . W !!?3,"This local form is associated with an obsolete printed claim form."
17 . W !?3,"Testing is not available for this form."
18 . Q
19 ;
20 S IBTYP=$P(IB2,U,2),IBFILE=+IB2
21 ;Select Entry #
22 S DIC=IBFILE,DIC(0)="AEMQ" D ^DIC
23 G:Y<0 TESTQ S (IBXIEN,IBIFN)=+Y
24 ;
25 S PARAMX("TEST")=1
26 I IBTYP="P" D DEV^IBCEFG7(IBFORM,1) G:$G(POP) TESTQ
27 I IBTYP="T" D QUE G:$G(IBQUE)="" TESTQ
28 ;
29 K ^TMP("IBXDATA",$J)
30 ;
31 ; Execute PRE-PROCESSOR
32 I $G(^IBE(353,IBFORM,"FPRE"))'="" X ^("FPRE") ;Form pre-processor
33 I $G(^IBE(353,IBFORM,"FPRE"))="",$G(^IBE(353,IBPAR,"FPRE"))'="" X ^("FPRE") ;Parent form pre-processor
34 G:$G(IBXERR)'="" FQ
35 ;
36 ; Extract record
37 I +$G(^IBE(353,IBFORM,2))=399 D
38 .S PARAMX(1)="BILL-SEARCH",Z0=$G(^DGCR(399,IBIFN,0))
39 .S Z=$P(Z0,U,21) S:Z="" Z="P" S PARAMX(2)=$P($G(^DGCR(399,IBIFN,"I"_($F("PST",Z)-1))),U),PARAMX(3)=$S($P(Z0,U,5)<3:"I",1:"O")
40 S Z=$$EXTRACT^IBCEFG(IBFORM,IBIFN,1,.PARAMX)
41 ;
42 G:'$D(^TMP("IBXDATA",$J)) FQ
43 ;
44 ; If an output routine exists, use it, otherwise use the generic ones
45 I $G(^IBE(353,IBFORM,"OUT"))'="" X ^("OUT") G FQ
46 ;
47 I IBTYP="P" D PRINT^IBCEFG7(IBFORM) D:'$D(ZTQUEUED) ^%ZISC G FQ
48 I IBTYP="T" D:$G(IBQUE)'="" TRANSMIT^IBCEFG7(IBFORM,IBQUE) G FQ
49 I IBTYP="S" D SCRN^IBCEFG70(IBFORM,IBIFN)
50 ;
51FQ ; Execute POST-PROCESSOR, if any
52 I $G(^IBE(353,IBFORM,"FPOST"))'="" X ^("FPOST") ;Form post-processor
53 I $G(^IBE(353,IBFORM,"FPOST"))="",$G(^IBE(353,IBPAR,"FPOST"))'="" X ^("FPOST") ;Parent form post-processor
54TESTQ K ^TMP("IBXDATA",$J)
55 D PAUSE^VALM1
56 S VALMBCK="R"
57 Q
58 ;
59QUE ;Select QUEUE to receive transmission
60 S %=1 W !,"Send transmission to your mailbox" D YN^DICN
61 I (%+1#3) S IBQUE=DUZ Q
62 S DIR(0)="F",DIR("A")="Enter a mail queue name: ",DIR(0)="A",DIR("?")="This is the mailman queue where the formatted test record should be sent"
63 D ^DIR K DIR S IBQUE=$S('$D(DIRUT):Y,1:"")
64 Q
65 ;
Note: See TracBrowser for help on using the repository browser.