IBEMTSCR.m

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 ---IBEMTSCR   3817     printed  Mar 13, 2025@21:27:08                                                                                                                                                                                                    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