[613] | 1 | IBEMTSCR ;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 | ;
|
---|
| 23 | DQ ; 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 | ;
|
---|
| 79 | SET(DATA) ; store report
|
---|
| 80 | S IBLINE=IBLINE+1,^TMP($J,"IBEMTSCR",IBLINE)=DATA
|
---|
| 81 | Q
|
---|
| 82 | ;
|
---|
| 83 | ;
|
---|
| 84 | SENDMSG(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 | ;
|
---|
| 91 | TYPE(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 | ;
|
---|
| 97 | ASKPRINT() ; 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 | ;
|
---|
| 107 | PAUSE ; 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 | ;
|
---|
| 111 | H ; 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
|
---|