IBAECB.m

IBAECB ;WOIFO/AAT-LTC BILLING CLOCK INQUIRY ; 21-FEB-02

 ;;2.0;INTEGRATED BILLING;**171,176**;21-MAR-94

 ;; Per VHA Directive 10-93-142, this routine should not be modified

 ;

 N IBQUIT,POP

 ;

 F  S IBQUIT=0 D ASKPT Q:IBQUIT

 Q

 ;

 ;

ASKPT ; Ask about patient and clock

 N IBDFN,IBCLK,X,Y,DIC

 W !

 S IBDFN=$$ASKPAT^IBAECP I IBDFN<1 S IBQUIT=1 Q  ; Patient code

 ; Enter required clock (if more than one)

 S IBCLK=$$ASKCLK^IBAECP(IBDFN) I IBCLK<0 Q

 F  S IBQUIT=0 D ASKDEV I IBQUIT S IBQUIT=IBQUIT-1 Q

 Q

 ;

ASKDEV ; Ask about device and print

 N DIR,DIRUT

 S %ZIS="QM" W ! D ^%ZIS

 I POP S IBQUIT=1 Q

 I $D(IO("Q")) D RUNTASK S IBQUIT=1 Q

 U IO D PRINT W !

 I IBQUIT S IBQUIT=2 Q

 S IBQUIT=1 W @IOF

 Q

 ;

RUNTASK N ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTQUEUED,ZTREQ

 S ZTRTN="PRINT^IBAECB"

 S ZTDESC="IB LTC BILLING CLOCK REPORT"

 S ZTSAVE("IBCLK")=""

 D ^%ZTLOAD

 W !!,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled")

 D HOME^%ZIS

 Q

 ;

HEADER N Y

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

 W !,Y,?22,"LTC Billing Clock Inquiry",!!

 Q

 ;

PRINT ;

 ; Input: IBCLK

 I $E(IOST,1,2)="C-" W @IOF ; Form feed to CRT only

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

 ;W !,"Printing clock ",IBCLK

 D REPORT^IBAECB1

 I $E(IOST,1,2)="C-" D PAUSE^IBAECB1

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

 D ^%ZISC

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBAECB   1300     printed  Apr 09, 2024@21:35:58                                                                                                                                                                                                      Page 2

IBAECB    ;WOIFO/AAT-LTC BILLING CLOCK INQUIRY ; 21-FEB-02

 +1       ;;2.0;INTEGRATED BILLING;**171,176**;21-MAR-94

 +2       ;; Per VHA Directive 10-93-142, this routine should not be modified

 +3       ;

 +4        NEW IBQUIT,POP

 +5       ;

 +6        FOR 

               SET IBQUIT=0

               DO ASKPT

               if IBQUIT

                   QUIT 

 +7        QUIT 

 +8       ;

 +9       ;

ASKPT     ; Ask about patient and clock

 +1        NEW IBDFN,IBCLK,X,Y,DIC

 +2        WRITE !

 +3       ; Patient code

           SET IBDFN=$$ASKPAT^IBAECP

           IF IBDFN<1

               SET IBQUIT=1

               QUIT 

 +4       ; Enter required clock (if more than one)

 +5        SET IBCLK=$$ASKCLK^IBAECP(IBDFN)

           IF IBCLK<0

               QUIT 

 +6        FOR 

               SET IBQUIT=0

               DO ASKDEV

               IF IBQUIT

                   SET IBQUIT=IBQUIT-1

                   QUIT 

 +7        QUIT 

 +8       ;

ASKDEV    ; Ask about device and print

 +1        NEW DIR,DIRUT

 +2        SET %ZIS="QM"

           WRITE !

           DO ^%ZIS

 +3        IF POP

               SET IBQUIT=1

               QUIT 

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

               DO RUNTASK

               SET IBQUIT=1

               QUIT 

 +5        USE IO

           DO PRINT

           WRITE !

 +6        IF IBQUIT

               SET IBQUIT=2

               QUIT 

 +7        SET IBQUIT=1

           WRITE @IOF

 +8        QUIT 

 +9       ;

RUNTASK    NEW ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTQUEUED,ZTREQ

 +1        SET ZTRTN="PRINT^IBAECB"

 +2        SET ZTDESC="IB LTC BILLING CLOCK REPORT"

 +3        SET ZTSAVE("IBCLK")=""

 +4        DO ^%ZTLOAD

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

 +6        DO HOME^%ZIS

 +7        QUIT 

 +8       ;

HEADER     NEW Y

 +1        SET Y=DT

           XECUTE ^DD("DD")

 +2        WRITE !,Y,?22,"LTC Billing Clock Inquiry",!!

 +3        QUIT 

 +4       ;

PRINT     ;

 +1       ; Input: IBCLK

 +2       ; Form feed to CRT only

           IF $EXTRACT(IOST,1,2)="C-"

               WRITE @IOF

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

               DO HEADER

 +4       ;W !,"Printing clock ",IBCLK

 +5        DO REPORT^IBAECB1

 +6        IF $EXTRACT(IOST,1,2)="C-"

               DO PAUSE^IBAECB1

 +7       ; Q

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +8        DO ^%ZISC

 +9        QUIT