IBODISP.m

IBODISP	;ALB/AAS - INTEGRATED BILLING - OUTPUTS ; 8-MAR-91

	;;Version 2.0 ; INTEGRATED BILLING ;; 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]

	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 IBJ=0:0 S IBJ=$O(^IB("APTDT",DFN,IBDT,IBJ)) Q:'IBJ!('S)!($D(DTOUT))  S DA=IBJ,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,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

IBODISP   ;ALB/AAS - INTEGRATED BILLING - OUTPUTS ; 8-MAR-91

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 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        SET DIC="^DPT("

           SET DIC(0)="AEQM"

           DO ^DIC

           KILL DIC

           IF +Y<1

               GOTO EN1Q

           SET DFN=+Y

 +7        DO DATE^IBOUTL

           IF 'IBEDT

               GOTO EN1

 +8       ;  -loop through inverse dates by patient and display

 +9        SET S=2

           SET IBDT=IBBDT-.0000001

           SET (IBQUIT,IBOCNT)=0

 +10       FOR IBI=0:0

               SET IBDT=$ORDER(^IB("APTDT",DFN,IBDT))

               IF 'IBDT!(IBDT>(IBEDT+.24))

                   QUIT 

               FOR IBJ=0:0

                   SET IBJ=$ORDER(^IB("APTDT",DFN,IBDT,IBJ))

                   IF 'IBJ!('S)!($DATA(DTOUT))

                       QUIT 

                   SET DA=IBJ

                   SET IBOCNT=IBOCNT+1

                   IF DA

                       DO DISP

                       DO PAUSE^IBOUTL

                       IF IBQUIT

                           GOTO EN1

 +11       IF IBOCNT<1

               WRITE !!,"No IB Actions Found for this Date Range",!!

 +12       GOTO EN1

EN1Q       KILL DIC,DA,DR,IBEDT,IBBDT,IBDT,IBI,IBJ,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