IBODISP ;ALB/AAS - INTEGRATED BILLING - OUTPUTS ; 8-MAR-91
;;2.0; INTEGRATED BILLING ;**17,199**; 21-MAR-94
;
EN ;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="EN^IBODISP" D T1^%ZOSV ;stop rt clock
;S XRTL=$ZU(0),XRTN="EN^IBODISP-1" D T0^%ZOSV ;start rt clock
; -display ib action by reference number
S DIC="^IB(",DIC(0)="AEQM" D ^DIC K DIC G ENQ:+Y<1 S DA=+Y D DISP G EN
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="EN^IBODISP" D T1^%ZOSV ;stop rt clock
Q
;
DISP S DIC="^IB(",DR="0:1" D EN^DIQ
Q
ENQ K DIC,DA,DR,Y,X,IBQT
Q
EN1 ;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="EN1^IBODISP" D T1^%ZOSV ;stop rt clock
;S XRTL=$ZU(0),XRTN="EN1^IBODISP-1" D T0^%ZOSV ;start rt clock
;
; -display ib action by patient [by date]
N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
S DIC="^DPT(",DIC(0)="AEQM" D ^DIC K DIC G EN1Q:+Y<1 S DFN=+Y
D DATE^IBOUTL G:'IBEDT EN1
; -loop through inverse dates by patient and display
S S=2,IBDT=IBBDT-.0000001,(IBQUIT,IBOCNT)=0
F IBI=0:0 S IBDT=$O(^IB("APTDT",DFN,IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) F IBJJ=0:0 S IBJJ=$O(^IB("APTDT",DFN,IBDT,IBJJ)) Q:'IBJJ!('S)!($D(DTOUT)) S DA=IBJJ,IBOCNT=IBOCNT+1 I DA D DISP,PAUSE^IBOUTL G:IBQUIT EN1
I IBOCNT<1 W !!,"No IB Actions Found for this Date Range",!!
G EN1
EN1Q K DIC,DA,DR,IBEDT,IBBDT,IBDT,IBI,IBJ,IBJJ,IBOCNT,S,X,Y,DFN,D0,IBQUIT
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="EN1^IBODISP" D T1^%ZOSV ;stop rt clock
Q
;
EN2 ;
; -print list of ib actions
;***
;S XRTL=$ZU(0),XRTN="EN2^IBODISP-1" D T0^%ZOSV ;start rt clock
W !!,"Print IB Action Entries by Date Added",!!," ** Please note that this output requires 132 columns **",!
S DIC="^IB(",L=0,FLDS="[IB LIST]",BY="@12,@"
D ASK G:$G(IBQT) ENQ
S DHD="INTEGRATED BILLING ACTIONS FROM: "_FR(1)_" TO: "_TO(1)
D EN1^DIP
K DIC,L,FLDS,FR,BY,TO
D ^%ZISC
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="EN2^IBODISP" D T1^%ZOSV ;stop rt clock
Q
ASK ;
N IBBDT,IBEDT
D DATE^IBOUTL
I (IBBDT<1)!(IBEDT<1) S IBQT=1 Q
S FR=IBBDT_",?",TO=IBEDT_",?"
S FR(1)=$$DAT1^IBOUTL(FR),TO(1)=$$DAT1^IBOUTL(TO)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBODISP 2083 printed Apr 09, 2024@21:06:12 Page 2
IBODISP ;ALB/AAS - INTEGRATED BILLING - OUTPUTS ; 8-MAR-91
+1 ;;2.0; INTEGRATED BILLING ;**17,199**; 21-MAR-94
+2 ;
EN ;
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN^IBODISP" D T1^%ZOSV ;stop rt clock
+3 ;S XRTL=$ZU(0),XRTN="EN^IBODISP-1" D T0^%ZOSV ;start rt clock
+4 ; -display ib action by reference number
+5 SET DIC="^IB("
SET DIC(0)="AEQM"
DO ^DIC
KILL DIC
if +Y<1
GOTO ENQ
SET DA=+Y
DO DISP
GOTO EN
+6 ;***
+7 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN^IBODISP" D T1^%ZOSV ;stop rt clock
+8 QUIT
+9 ;
DISP SET DIC="^IB("
SET DR="0:1"
DO EN^DIQ
+1 QUIT
ENQ KILL DIC,DA,DR,Y,X,IBQT
+1 QUIT
EN1 ;
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN1^IBODISP" D T1^%ZOSV ;stop rt clock
+3 ;S XRTL=$ZU(0),XRTN="EN1^IBODISP-1" D T0^%ZOSV ;start rt clock
+4 ;
+5 ; -display ib action by patient [by date]
+6 ;Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+7 SET DIC="^DPT("
SET DIC(0)="AEQM"
DO ^DIC
KILL DIC
if +Y<1
GOTO EN1Q
SET DFN=+Y
+8 DO DATE^IBOUTL
if 'IBEDT
GOTO EN1
+9 ; -loop through inverse dates by patient and display
+10 SET S=2
SET IBDT=IBBDT-.0000001
SET (IBQUIT,IBOCNT)=0
+11 FOR IBI=0:0
SET IBDT=$ORDER(^IB("APTDT",DFN,IBDT))
if 'IBDT!(IBDT>(IBEDT+.24))
QUIT
FOR IBJJ=0:0
SET IBJJ=$ORDER(^IB("APTDT",DFN,IBDT,IBJJ))
if 'IBJJ!('S)!($DATA(DTOUT))
QUIT
SET DA=IBJJ
SET IBOCNT=IBOCNT+1
IF DA
DO DISP
DO PAUSE^IBOUTL
if IBQUIT
GOTO EN1
+12 IF IBOCNT<1
WRITE !!,"No IB Actions Found for this Date Range",!!
+13 GOTO EN1
EN1Q KILL DIC,DA,DR,IBEDT,IBBDT,IBDT,IBI,IBJ,IBJJ,IBOCNT,S,X,Y,DFN,D0,IBQUIT
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN1^IBODISP" D T1^%ZOSV ;stop rt clock
+3 QUIT
+4 ;
EN2 ;
+1 ; -print list of ib actions
+2 ;***
+3 ;S XRTL=$ZU(0),XRTN="EN2^IBODISP-1" D T0^%ZOSV ;start rt clock
+4 WRITE !!,"Print IB Action Entries by Date Added",!!," ** Please note that this output requires 132 columns **",!
+5 SET DIC="^IB("
SET L=0
SET FLDS="[IB LIST]"
SET BY="@12,@"
+6 DO ASK
if $GET(IBQT)
GOTO ENQ
+7 SET DHD="INTEGRATED BILLING ACTIONS FROM: "_FR(1)_" TO: "_TO(1)
+8 DO EN1^DIP
+9 KILL DIC,L,FLDS,FR,BY,TO
+10 DO ^%ZISC
+11 ;***
+12 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN2^IBODISP" D T1^%ZOSV ;stop rt clock
+13 QUIT
ASK ;
+1 NEW IBBDT,IBEDT
+2 DO DATE^IBOUTL
+3 IF (IBBDT<1)!(IBEDT<1)
SET IBQT=1
QUIT
+4 SET FR=IBBDT_",?"
SET TO=IBEDT_",?"
+5 SET FR(1)=$$DAT1^IBOUTL(FR)
SET TO(1)=$$DAT1^IBOUTL(TO)
+6 QUIT
