IBEMTSCR ;ALB/RFJ-print billable types for visit copay ;23 Nov 01
;;2.0;INTEGRATED BILLING;**167,187,351**;21-MAR-94;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
W !!,"This option will print the billable types for copay visits."
W !,"You have the option to deliver the report to yourself in MailMan"
W !,"or print the report to a printer or on your screen."
;
N IBFMAIL,%ZIS,IBFPOST,POP,ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE
S IBFMAIL=$$ASKPRINT
I IBFMAIL<0 Q
;
; select device
I 'IBFMAIL D I $D(IO("Q"))!(POP) K IO("Q"),ZTSK Q
. W ! S %ZIS="Q" D ^%ZIS Q:POP
. I $D(IO("Q")) D D ^%ZTLOAD Q
. . S ZTDESC="IB Visit Copay Billing Types",ZTRTN="DQ^IBEMTSCR"
. . S ZTSAVE("IBFMAIL")="",ZTSAVE("ZTREQ")="@"
;
W !!,"<*> please wait <*>"
;
;
DQ ; print report
; variable ibfmail=1 to print to a mail message
; variable ibfpost=1 if from post init
N IBDA,IBDATA,IBLINE,IBSTOP,X,XMY
;
; *** build the report in tmp ***
;
; report line counter
S IBLINE=0
;
D SET("This message is a summary of the Visit Copay Billing Types defined")
D SET("for your station.")
;D SET("IB MEANS TEST.")
D SET(" ")
;
D SET("The following Visit Copay Billing Types are defined for your station:")
D SET("Stop Code Description Effective Date Billable Type")
D SET("--------- ----------------------------- -------------- -------------")
S IBSTOP="" F S IBSTOP=$O(^IBE(352.5,"B",IBSTOP)) Q:IBSTOP="" D
. S IBDA=0 F S IBDA=$O(^IBE(352.5,"B",IBSTOP,IBDA)) Q:'IBDA S IBDATA=^IBE(352.5,IBDA,0) D
. . ; stop code
. . S X=$J($P(IBDATA,"^"),9)
. . ; description
. . S X=X_" "_$P(IBDATA,"^",4)_$J("",35-$L($P(IBDATA,"^",4)))
. . ; effective date
. . I '$P(IBDATA,"^",2) S $P(IBDATA,"^",2)="???????"
. . S X=X_$E($P(IBDATA,"^",2),4,5)_"/"_$E($P(IBDATA,"^",2),6,7)_"/"_$E($P(IBDATA,"^",2),2,3)
. . ; billable type
. . D SET(X_$J("",8)_$$TYPE($P(IBDATA,"^",3)))
;
; *** print or deliver the report from tmp ***
;
; print the report
I '$G(IBFMAIL) D
. N %,%I,IBFLAG,IBNOW,IBPAGE,IBSCREEN,X,Y
. D NOW^%DTC S Y=% D DD^%DT S IBNOW=Y
. S IBPAGE=1
. S IBSCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S IBSCREEN=1
. U IO D H
. ;
. S IBLINE=0 F S IBLINE=$O(^TMP($J,"IBEMTSCR",IBLINE)) Q:'IBLINE!($G(IBFLAG)) S IBDATA=^(IBLINE) D
. . I $Y>(IOSL-4) D:IBSCREEN PAUSE Q:$G(IBFLAG) D H
. . W !,IBDATA
. ;
. D ^%ZISC
;
; deliver the report in mailman
I $G(IBFMAIL) D
. I $G(IBFPOST) S XMY("G.IB MEANS TEST")=""
. S XMY(DUZ)=""
. S X=$$SENDMSG("IB Visit Copay Billing Types",.XMY)
;
K ^TMP($J,"IBEMTSCR")
Q
;
;
SET(DATA) ; store report
S IBLINE=IBLINE+1,^TMP($J,"IBEMTSCR",IBLINE)=DATA
Q
;
;
SENDMSG(XMSUB,XMY) ; send message with subject and recipients
N %X,D0,D1,D2,DIC,DICR,DIW,X,XCNP,XMDISPI,XMDUN,XMDUZ,XMTEXT,XMZ,ZTPAR
S XMDUZ="IB PACKAGE",XMTEXT="^TMP($J,""IBEMTSCR"","
D ^XMD
Q +$G(XMZ)
;
;
TYPE(CODE) ; return the billable type based on set of codes
I CODE=1 Q "Basic Care"
I CODE=2 Q "Specialty Care"
Q "Non-Billable"
;
;
ASKPRINT() ; ask to print in mail or printer
; 1 is yes, otherwise no
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Do you want to deliver the report in MailMan"
W ! D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
Q Y
;
;
PAUSE ; pause at end of page
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
;
;
H ; header
S %=IBNOW_" PAGE "_IBPAGE,IBPAGE=IBPAGE+1 I IBPAGE'=2!(IBSCREEN) W @IOF
W $C(13),"IB VISIT COPAY BILLING TYPES",?(80-$L(%)),%
W !,$TR($J("",79)," ","-")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEMTSCR 3817 printed Dec 13, 2024@02:22:10 Page 2
IBEMTSCR ;ALB/RFJ-print billable types for visit copay ;23 Nov 01
+1 ;;2.0;INTEGRATED BILLING;**167,187,351**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 WRITE !!,"This option will print the billable types for copay visits."
+5 WRITE !,"You have the option to deliver the report to yourself in MailMan"
+6 WRITE !,"or print the report to a printer or on your screen."
+7 ;
+8 NEW IBFMAIL,%ZIS,IBFPOST,POP,ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE
+9 SET IBFMAIL=$$ASKPRINT
+10 IF IBFMAIL<0
QUIT
+11 ;
+12 ; select device
+13 IF 'IBFMAIL
Begin DoDot:1
+14 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+15 IF $DATA(IO("Q"))
Begin DoDot:2
+16 SET ZTDESC="IB Visit Copay Billing Types"
SET ZTRTN="DQ^IBEMTSCR"
+17 SET ZTSAVE("IBFMAIL")=""
SET ZTSAVE("ZTREQ")="@"
End DoDot:2
DO ^%ZTLOAD
QUIT
End DoDot:1
IF $DATA(IO("Q"))!(POP)
KILL IO("Q"),ZTSK
QUIT
+18 ;
+19 WRITE !!,"<*> please wait <*>"
+20 ;
+21 ;
DQ ; print report
+1 ; variable ibfmail=1 to print to a mail message
+2 ; variable ibfpost=1 if from post init
+3 NEW IBDA,IBDATA,IBLINE,IBSTOP,X,XMY
+4 ;
+5 ; *** build the report in tmp ***
+6 ;
+7 ; report line counter
+8 SET IBLINE=0
+9 ;
+10 DO SET("This message is a summary of the Visit Copay Billing Types defined")
+11 DO SET("for your station.")
+12 ;D SET("IB MEANS TEST.")
+13 DO SET(" ")
+14 ;
+15 DO SET("The following Visit Copay Billing Types are defined for your station:")
+16 DO SET("Stop Code Description Effective Date Billable Type")
+17 DO SET("--------- ----------------------------- -------------- -------------")
+18 SET IBSTOP=""
FOR
SET IBSTOP=$ORDER(^IBE(352.5,"B",IBSTOP))
if IBSTOP=""
QUIT
Begin DoDot:1
+19 SET IBDA=0
FOR
SET IBDA=$ORDER(^IBE(352.5,"B",IBSTOP,IBDA))
if 'IBDA
QUIT
SET IBDATA=^IBE(352.5,IBDA,0)
Begin DoDot:2
+20 ; stop code
+21 SET X=$JUSTIFY($PIECE(IBDATA,"^"),9)
+22 ; description
+23 SET X=X_" "_$PIECE(IBDATA,"^",4)_$JUSTIFY("",35-$LENGTH($PIECE(IBDATA,"^",4)))
+24 ; effective date
+25 IF '$PIECE(IBDATA,"^",2)
SET $PIECE(IBDATA,"^",2)="???????"
+26 SET X=X_$EXTRACT($PIECE(IBDATA,"^",2),4,5)_"/"_$EXTRACT($PIECE(IBDATA,"^",2),6,7)_"/"_$EXTRACT($PIECE(IBDATA,"^",2),2,3)
+27 ; billable type
+28 DO SET(X_$JUSTIFY("",8)_$$TYPE($PIECE(IBDATA,"^",3)))
End DoDot:2
End DoDot:1
+29 ;
+30 ; *** print or deliver the report from tmp ***
+31 ;
+32 ; print the report
+33 IF '$GET(IBFMAIL)
Begin DoDot:1
+34 NEW %,%I,IBFLAG,IBNOW,IBPAGE,IBSCREEN,X,Y
+35 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET IBNOW=Y
+36 SET IBPAGE=1
+37 SET IBSCREEN=0
IF '$DATA(ZTQUEUED)
IF IO=IO(0)
IF $EXTRACT(IOST)="C"
SET IBSCREEN=1
+38 USE IO
DO H
+39 ;
+40 SET IBLINE=0
FOR
SET IBLINE=$ORDER(^TMP($JOB,"IBEMTSCR",IBLINE))
if 'IBLINE!($GET(IBFLAG))
QUIT
SET IBDATA=^(IBLINE)
Begin DoDot:2
+41 IF $Y>(IOSL-4)
if IBSCREEN
DO PAUSE
if $GET(IBFLAG)
QUIT
DO H
+42 WRITE !,IBDATA
End DoDot:2
+43 ;
+44 DO ^%ZISC
End DoDot:1
+45 ;
+46 ; deliver the report in mailman
+47 IF $GET(IBFMAIL)
Begin DoDot:1
+48 IF $GET(IBFPOST)
SET XMY("G.IB MEANS TEST")=""
+49 SET XMY(DUZ)=""
+50 SET X=$$SENDMSG("IB Visit Copay Billing Types",.XMY)
End DoDot:1
+51 ;
+52 KILL ^TMP($JOB,"IBEMTSCR")
+53 QUIT
+54 ;
+55 ;
SET(DATA) ; store report
+1 SET IBLINE=IBLINE+1
SET ^TMP($JOB,"IBEMTSCR",IBLINE)=DATA
+2 QUIT
+3 ;
+4 ;
SENDMSG(XMSUB,XMY) ; send message with subject and recipients
+1 NEW %X,D0,D1,D2,DIC,DICR,DIW,X,XCNP,XMDISPI,XMDUN,XMDUZ,XMTEXT,XMZ,ZTPAR
+2 SET XMDUZ="IB PACKAGE"
SET XMTEXT="^TMP($J,""IBEMTSCR"","
+3 DO ^XMD
+4 QUIT +$GET(XMZ)
+5 ;
+6 ;
TYPE(CODE) ; return the billable type based on set of codes
+1 IF CODE=1
QUIT "Basic Care"
+2 IF CODE=2
QUIT "Specialty Care"
+3 QUIT "Non-Billable"
+4 ;
+5 ;
ASKPRINT() ; ask to print in mail or printer
+1 ; 1 is yes, otherwise no
+2 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="YO"
SET DIR("B")="NO"
+4 SET DIR("A")=" Do you want to deliver the report in MailMan"
+5 WRITE !
DO ^DIR
+6 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+7 QUIT Y
+8 ;
+9 ;
PAUSE ; pause at end of page
+1 NEW X
USE IO(0)
WRITE !!,"Press RETURN to continue, '^' to exit:"
READ X:DTIME
if '$TEST
SET X="^"
if X["^"
SET IBFLAG=1
USE IO
QUIT
+2 ;
+3 ;
H ; header
+1 SET %=IBNOW_" PAGE "_IBPAGE
SET IBPAGE=IBPAGE+1
IF IBPAGE'=2!(IBSCREEN)
WRITE @IOF
+2 WRITE $CHAR(13),"IB VISIT COPAY BILLING TYPES",?(80-$LENGTH(%)),%
+3 WRITE !,$TRANSLATE($JUSTIFY("",79)," ","-")
+4 QUIT
