IBOBCRT.m

IBOBCRT ;ALB/RJS - IB-BILLING-CYCLE-REPORT 12/19/91

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

CATCCLK ;

 ;***

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

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

 ;***

 S DIC="^IBE(351,",DIC(0)="AEQSMZ"  ; IB*2.0*747

 S DIC("A")="Select MT Billing Clock by PATIENT NAME: "

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

 D ^DIC

 I Y<0 G END

 S IBD0=$P(Y,"^",1)

 W ! D OPEN G END:POP

 I $D(IO("Q")) D QUEUED,HOME^%ZIS G CATCCLK

 U IO D DQ

 W ! S DIR(0)="E" D ^DIR I '$D(DIRUT) W @IOF G CATCCLK

 Q

OPEN ;

 S %ZIS="QM" D ^%ZIS

 Q

QUEUED ;

 S ZTRTN="DQ^IBOBCRT",ZTDESC="IB BILLING REPORT",ZTSAVE("IBD0")="" D ^%ZTLOAD W !!,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled")

 Q

HEADER ;

 S Y=DT X ^DD("DD")

 W !,Y,"            Billing Cycle Inquiry",?30,!!

 K Y

 Q

DQ ;

 ;***

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

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

 ;*** suppress initial form feed (to all but crts)

 W:$E(IOST,1,2)["C-" @IOF

 S D0=IBD0

 I $E(IOST,1,2)="P-" D HEADER

 K DXS D ^IBXBCR2 K DXS D ^IBXBCR K DXS

END ;

 ;***

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

 I $D(ZTQUEUED) S ZTREQ="@" Q

 D ^%ZISC

 K D0,DIC,DIR,DIRUT,DXS,POP,Y,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,IBD0

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBOBCRT   1406     printed  Apr 09, 2024@21:38:42                                                                                                                                                                                                     Page 2

IBOBCRT   ;ALB/RJS - IB-BILLING-CYCLE-REPORT 12/19/91

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

CATCCLK   ;

 +1       ;***

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

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

 +4       ;***

 +5       ; IB*2.0*747

           SET DIC="^IBE(351,"

           SET DIC(0)="AEQSMZ"

 +6        SET DIC("A")="Select MT Billing Clock by PATIENT NAME: "

 +7       ;Suppress PATIENT file fuzzy lookups

           NEW DPTNOFZY

           SET DPTNOFZY=1

 +8        DO ^DIC

 +9        IF Y<0

               GOTO END

 +10       SET IBD0=$PIECE(Y,"^",1)

 +11       WRITE !

           DO OPEN

           if POP

               GOTO END

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

               DO QUEUED

               DO HOME^%ZIS

               GOTO CATCCLK

 +13       USE IO

           DO DQ

 +14       WRITE !

           SET DIR(0)="E"

           DO ^DIR

           IF '$DATA(DIRUT)

               WRITE @IOF

               GOTO CATCCLK

 +15       QUIT 

OPEN      ;

 +1        SET %ZIS="QM"

           DO ^%ZIS

 +2        QUIT 

QUEUED    ;

 +1        SET ZTRTN="DQ^IBOBCRT"

           SET ZTDESC="IB BILLING REPORT"

           SET ZTSAVE("IBD0")=""

           DO ^%ZTLOAD

           WRITE !!,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled")

 +2        QUIT 

HEADER    ;

 +1        SET Y=DT

           XECUTE ^DD("DD")

 +2        WRITE !,Y,"            Billing Cycle Inquiry",?30,!!

 +3        KILL Y

 +4        QUIT 

DQ        ;

 +1       ;***

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

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

 +4       ;*** suppress initial form feed (to all but crts)

 +5        if $EXTRACT(IOST,1,2)["C-"

               WRITE @IOF

 +6        SET D0=IBD0

 +7        IF $EXTRACT(IOST,1,2)="P-"

               DO HEADER

 +8        KILL DXS

           DO ^IBXBCR2

           KILL DXS

           DO ^IBXBCR

           KILL DXS

END       ;

 +1       ;***

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

 +3        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

               QUIT 

 +4        DO ^%ZISC

 +5        KILL D0,DIC,DIR,DIRUT,DXS,POP,Y,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,IBD0

 +6        QUIT