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 ---[H[J[2J[HIBOMTP 1290 printed Dec 13, 2024@02:25: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
