- 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 Jan 18, 2025@03:26:37 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