IBOMTP.m

IBOMTP ;ALB/CPM - MEANS TEST BILLING PROFILE ; 10-DEC-91

 ;;2.0;INTEGRATED BILLING;**153,199**;21-MAR-94

 ;

 S:'$D(DTIME) DTIME=300 D HOME^%ZIS

 ;

ASK ;

 ;***

 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP" D T1^%ZOSV ;stop rt clock

 ;S XRTL=$ZU(0),XRTN="IBOMTP-1" D T0^%ZOSV ;start rt clock

 N DPTNOFZY S DPTNOFZY=1  ;Suppress PATIENT file fuzzy lookups

 S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC G END:Y<1 S IBDFN=+Y

 ;

 ; Select Start and End dates.

BDT S %DT="AEPX",%DT("A")="Start with DATE: ",%DT("B")="OCT 01, 1990" D ^%DT K %DT G END:Y<0 S IBBDT=Y

EDT S Y=DT D DD^%DT S %DT="EX" W !,"Go to DATE: ",Y,"//" R X:DTIME

 G END:'$T!(X["^") S:X="" X=DT D ^%DT G EDT:Y<0 S IBEDT=Y

 I Y<IBBDT W *7," ??",!,"ENDING DATE must follow BEGINNING DATE.",! G BDT

 ;

 ; Select an output device.

 S %ZIS="QM" D ^%ZIS G:POP END

 I $D(IO("Q")) D  D ^%ZTLOAD K IO("Q") D HOME^%ZIS,END W ! G ASK

 . S ZTRTN="^IBOMTP1",ZTDESC="MEANS TEST BILLING PROFILE"

 . S (ZTSAVE("IBBDT"),ZTSAVE("IBEDT"),ZTSAVE("IBDFN"))=""

 U IO

 ;***

 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP" D T1^%ZOSV ;stop rt clock

 D ^IBOMTP1 ; generate report

 D END W ! G ASK ; re-run for next patient

 ;

END ;

 K %DT,IBDFN,IBBDT,IBEDT,X,Y,ZTSK

 ;***

 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP" D T1^%ZOSV ;stop rt clock

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBOMTP   1290     printed  Mar 13, 2025@21:30:56                                                                                                                                                                                                      Page 2

IBOMTP    ;ALB/CPM - MEANS TEST BILLING PROFILE ; 10-DEC-91

 +1       ;;2.0;INTEGRATED BILLING;**153,199**;21-MAR-94

 +2       ;

 +3        if '$DATA(DTIME)

               SET DTIME=300

           DO HOME^%ZIS

 +4       ;

ASK       ;

 +1       ;***

 +2       ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP" D T1^%ZOSV ;stop rt clock

 +3       ;S XRTL=$ZU(0),XRTN="IBOMTP-1" D T0^%ZOSV ;start rt clock

 +4       ;Suppress PATIENT file fuzzy lookups

           NEW DPTNOFZY

           SET DPTNOFZY=1

 +5        SET DIC="^DPT("

           SET DIC(0)="AEQMN"

           DO ^DIC

           KILL DIC

           if Y<1

               GOTO END

           SET IBDFN=+Y

 +6       ;

 +7       ; Select Start and End dates.

BDT        SET %DT="AEPX"

           SET %DT("A")="Start with DATE: "

           SET %DT("B")="OCT 01, 1990"

           DO ^%DT

           KILL %DT

           if Y<0

               GOTO END

           SET IBBDT=Y

EDT        SET Y=DT

           DO DD^%DT

           SET %DT="EX"

           WRITE !,"Go to DATE: ",Y,"//"

           READ X:DTIME

 +1        if '$TEST!(X["^")

               GOTO END

           if X=""

               SET X=DT

           DO ^%DT

           if Y<0

               GOTO EDT

           SET IBEDT=Y

 +2        IF Y<IBBDT

               WRITE *7," ??",!,"ENDING DATE must follow BEGINNING DATE.",!

               GOTO BDT

 +3       ;

 +4       ; Select an output device.

 +5        SET %ZIS="QM"

           DO ^%ZIS

           if POP

               GOTO END

 +6        IF $DATA(IO("Q"))

               Begin DoDot:1

 +7                SET ZTRTN="^IBOMTP1"

                   SET ZTDESC="MEANS TEST BILLING PROFILE"

 +8                SET (ZTSAVE("IBBDT"),ZTSAVE("IBEDT"),ZTSAVE("IBDFN"))=""

               End DoDot:1

               DO ^%ZTLOAD

               KILL IO("Q")

               DO HOME^%ZIS

               DO END

               WRITE !

               GOTO ASK

 +9        USE IO

 +10      ;***

 +11      ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP" D T1^%ZOSV ;stop rt clock

 +12      ; generate report

           DO ^IBOMTP1

 +13      ; re-run for next patient

           DO END

           WRITE !

           GOTO ASK

 +14      ;

END       ;

 +1        KILL %DT,IBDFN,IBBDT,IBEDT,X,Y,ZTSK

 +2       ;***

 +3       ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP" D T1^%ZOSV ;stop rt clock

 +4        QUIT