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

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1IBEMTSCR ;ALB/RFJ-print billable types for visit copay ;23 Nov 01
2 ;;2.0;INTEGRATED BILLING;**167,187,351**;21-MAR-94;Build 4
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 W !!,"This option will print the billable types for copay visits."
6 W !,"You have the option to deliver the report to yourself in MailMan"
7 W !,"or print the report to a printer or on your screen."
8 ;
9 N IBFMAIL,%ZIS,IBFPOST,POP,ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE
10 S IBFMAIL=$$ASKPRINT
11 I IBFMAIL<0 Q
12 ;
13 ; select device
14 I 'IBFMAIL D I $D(IO("Q"))!(POP) K IO("Q"),ZTSK Q
15 . W ! S %ZIS="Q" D ^%ZIS Q:POP
16 . I $D(IO("Q")) D D ^%ZTLOAD Q
17 . . S ZTDESC="IB Visit Copay Billing Types",ZTRTN="DQ^IBEMTSCR"
18 . . S ZTSAVE("IBFMAIL")="",ZTSAVE("ZTREQ")="@"
19 ;
20 W !!,"<*> please wait <*>"
21 ;
22 ;
23DQ ; print report
24 ; variable ibfmail=1 to print to a mail message
25 ; variable ibfpost=1 if from post init
26 N IBDA,IBDATA,IBLINE,IBSTOP,X,XMY
27 ;
28 ; *** build the report in tmp ***
29 ;
30 ; report line counter
31 S IBLINE=0
32 ;
33 D SET("This message is a summary of the Visit Copay Billing Types defined")
34 D SET("for your station.")
35 ;D SET("IB MEANS TEST.")
36 D SET(" ")
37 ;
38 D SET("The following Visit Copay Billing Types are defined for your station:")
39 D SET("Stop Code Description Effective Date Billable Type")
40 D SET("--------- ----------------------------- -------------- -------------")
41 S IBSTOP="" F S IBSTOP=$O(^IBE(352.5,"B",IBSTOP)) Q:IBSTOP="" D
42 . S IBDA=0 F S IBDA=$O(^IBE(352.5,"B",IBSTOP,IBDA)) Q:'IBDA S IBDATA=^IBE(352.5,IBDA,0) D
43 . . ; stop code
44 . . S X=$J($P(IBDATA,"^"),9)
45 . . ; description
46 . . S X=X_" "_$P(IBDATA,"^",4)_$J("",35-$L($P(IBDATA,"^",4)))
47 . . ; effective date
48 . . I '$P(IBDATA,"^",2) S $P(IBDATA,"^",2)="???????"
49 . . S X=X_$E($P(IBDATA,"^",2),4,5)_"/"_$E($P(IBDATA,"^",2),6,7)_"/"_$E($P(IBDATA,"^",2),2,3)
50 . . ; billable type
51 . . D SET(X_$J("",8)_$$TYPE($P(IBDATA,"^",3)))
52 ;
53 ; *** print or deliver the report from tmp ***
54 ;
55 ; print the report
56 I '$G(IBFMAIL) D
57 . N %,%I,IBFLAG,IBNOW,IBPAGE,IBSCREEN,X,Y
58 . D NOW^%DTC S Y=% D DD^%DT S IBNOW=Y
59 . S IBPAGE=1
60 . S IBSCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S IBSCREEN=1
61 . U IO D H
62 . ;
63 . S IBLINE=0 F S IBLINE=$O(^TMP($J,"IBEMTSCR",IBLINE)) Q:'IBLINE!($G(IBFLAG)) S IBDATA=^(IBLINE) D
64 . . I $Y>(IOSL-4) D:IBSCREEN PAUSE Q:$G(IBFLAG) D H
65 . . W !,IBDATA
66 . ;
67 . D ^%ZISC
68 ;
69 ; deliver the report in mailman
70 I $G(IBFMAIL) D
71 . I $G(IBFPOST) S XMY("G.IB MEANS TEST")=""
72 . S XMY(DUZ)=""
73 . S X=$$SENDMSG("IB Visit Copay Billing Types",.XMY)
74 ;
75 K ^TMP($J,"IBEMTSCR")
76 Q
77 ;
78 ;
79SET(DATA) ; store report
80 S IBLINE=IBLINE+1,^TMP($J,"IBEMTSCR",IBLINE)=DATA
81 Q
82 ;
83 ;
84SENDMSG(XMSUB,XMY) ; send message with subject and recipients
85 N %X,D0,D1,D2,DIC,DICR,DIW,X,XCNP,XMDISPI,XMDUN,XMDUZ,XMTEXT,XMZ,ZTPAR
86 S XMDUZ="IB PACKAGE",XMTEXT="^TMP($J,""IBEMTSCR"","
87 D ^XMD
88 Q +$G(XMZ)
89 ;
90 ;
91TYPE(CODE) ; return the billable type based on set of codes
92 I CODE=1 Q "Basic Care"
93 I CODE=2 Q "Specialty Care"
94 Q "Non-Billable"
95 ;
96 ;
97ASKPRINT() ; ask to print in mail or printer
98 ; 1 is yes, otherwise no
99 N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
100 S DIR(0)="YO",DIR("B")="NO"
101 S DIR("A")=" Do you want to deliver the report in MailMan"
102 W ! D ^DIR
103 I $G(DTOUT)!($G(DUOUT)) S Y=-1
104 Q Y
105 ;
106 ;
107PAUSE ; pause at end of page
108 N X U IO(0) W !!,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" IBFLAG=1 U IO Q
109 ;
110 ;
111H ; header
112 S %=IBNOW_" PAGE "_IBPAGE,IBPAGE=IBPAGE+1 I IBPAGE'=2!(IBSCREEN) W @IOF
113 W $C(13),"IB VISIT COPAY BILLING TYPES",?(80-$L(%)),%
114 W !,$TR($J("",79)," ","-")
115 Q
Note: See TracBrowser for help on using the repository browser.