IBCF1TP.m

IBCF1TP	;ALB/MJB - UB-82 TEST PATTERN PRINT  ;23 SEP 88 13:42

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

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

	;

	;MAP TO DGCRTP

	;

ZIS	;

	;***

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

	;

	S %ZIS="QM" D ^%ZIS G:POP Q

	I $D(IO("Q")) K IO("Q") S ZTRTN="ENP^IBCF1TP",ZTDESC="IB - TEST UB-82 PRINT" D ^%ZTLOAD K ZTSK D HOME^%ZIS G Q

	U IO

	;***

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

	;

	D ENP

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

	K DGPGM,DGVAR,POP

	;***

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

	Q

ENP	;

	;***

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

	;

	W @IOF,?24,"*** UB-82 TEST PATTERN ***",!,"AGENT CASHIER",!,"AGENT CASHIER STREET",?24," F. L. 2",?57,"BILL NUMBER",?74,"XXX"

	W !,"CITY STATE  ZIP",!,"PHONE #",?24,"BC/BS #",?38,"FED TAX #",?71,"F. L. 9"

	W !!,"PATIENT NAME",?33,"PATIENT ADDRESS",!!,"PT DOB",?8,"X",?10,"X",?14,"ADM DT",?21,"HR",?25,"X",?28,"X",?30,"AH",?33,"DH",?36,"XX",?40,"FROM",?48,"TO",?70,"F. L. 27",!!

	W "OC",?3,"DATE" W ?11,"OC",?14,"DATE" W ?22,"OC",?25,"DATE",?35,"OC",?38,"DATE",?46,"OC",?49,"DATE"

	W !,"MAILING ADDRESS NAME",!,"STREET ADDRESS 1",?30,"CC",?33,"CC",?36,"CC",?39,"CC",?42,"CC",?61,"F. L. 45"

	W !,"STREET ADDRESS 2",!,"STREET ADDRESS 3"

	W !,"CITY",?$X+2,"STATE",?$X+2,"ZIP"

8	W !!!!,"000 DAYS MEDICAL CARE",!

	F I=1:1:3 W !,"REV CODE ",I,?24,"000.00",?31,"000",?35,"00",?39,"  0000.00"

	W !!,"SUBTOTAL",?39," 00000.00"

	F I=1:1 Q:$Y=30  W !

	W !!,"TOTAL",?39," 00000.00"

	F I=1:1 Q:$Y=40  W !

	F I=1:1:3 W !,"PAYER ",I,?24,"X",?27,"X"

	F I=1:1 Q:$Y=45  W !

	F I=1:1:3 W !,"INSURED NAME ",I,?23,"X",?26,"XX",?29,"POLICY # ",I,?46,"GROUP NAME ",I,?61,"GROUP # ",I

	F I=1:1 Q:$Y=50  W !

	W "X",?2,"X",?4,"EMPLOYER NAME",?42,"CITY  STATE  ZIP"

	F I=1:1 Q:$Y=53  W !

	W "PRINCIPAL DIAGNOSIS",?44,"CODE" F I=51,58,65,72 W ?I,"CODE"

	W !!,"X",?3,"PRINCIPAL PROCEDURE",?44,"CODE",?51,"DATE",?57,"CODE",?63,"DATE",?68,"CODE",?74,"DATE"

	F I=1:1 Q:$Y=56  W !

	W !?22,"TX. AUTH.",?33,"Dept. Veterans Affairs",?56,"F. L. 93"

	W !!,"Patient ID: ","XXXXXXXXX",!,"Bill Type: ","XXXX XXXXXXX",!,"UB-82 TEST PATTERN",!,"**TEST PATTERN**"

16	F I=1:1 Q:$Y=62  W !

	W ?46,"UB-82 SIGNER NAME",!,?46,"UB-82 SIGNER TITLE",?69,"DATE"

	K I

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

	D ^%ZISC

	;***

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

	Q

	;IBCF1TP

IBCF1TP   ;ALB/MJB - UB-82 TEST PATTERN PRINT  ;23 SEP 88 13:42

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

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

 +3       ;

 +4       ;MAP TO DGCRTP

 +5       ;

ZIS       ;

 +1       ;***

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

 +3       ;

 +4        SET %ZIS="QM"

           DO ^%ZIS

           IF POP

               GOTO Q

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

               KILL IO("Q")

               SET ZTRTN="ENP^IBCF1TP"

               SET ZTDESC="IB - TEST UB-82 PRINT"

               DO ^%ZTLOAD

               KILL ZTSK

               DO HOME^%ZIS

               GOTO Q

 +6        USE IO

 +7       ;***

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

 +9       ;

 +10       DO ENP

Q          IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +1        KILL DGPGM,DGVAR,POP

 +2       ;***

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

 +4        QUIT 

ENP       ;

 +1       ;***

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

 +3       ;

 +4        WRITE @IOF,?24,"*** UB-82 TEST PATTERN ***",!,"AGENT CASHIER",!,"AGENT CASHIER STREET",?24," F. L. 2",?57,"BILL NUMBER",?74,"XXX"

 +5        WRITE !,"CITY STATE  ZIP",!,"PHONE #",?24,"BC/BS #",?38,"FED TAX #",?71,"F. L. 9"

 +6        WRITE !!,"PATIENT NAME",?33,"PATIENT ADDRESS",!!,"PT DOB",?8,"X",?10,"X",?14,"ADM DT",?21,"HR",?25,"X",?28,"X",?30,"AH",?33,"DH",?36,"XX",?40,"FROM",?48,"TO",?70,"F. L. 27",!!

 +7        WRITE "OC",?3,"DATE"

           WRITE ?11,"OC",?14,"DATE"

           WRITE ?22,"OC",?25,"DATE",?35,"OC",?38,"DATE",?46,"OC",?49,"DATE"

 +8        WRITE !,"MAILING ADDRESS NAME",!,"STREET ADDRESS 1",?30,"CC",?33,"CC",?36,"CC",?39,"CC",?42,"CC",?61,"F. L. 45"

 +9        WRITE !,"STREET ADDRESS 2",!,"STREET ADDRESS 3"

 +10       WRITE !,"CITY",?$X+2,"STATE",?$X+2,"ZIP"

8          WRITE !!!!,"000 DAYS MEDICAL CARE",!

 +1        FOR I=1:1:3

               WRITE !,"REV CODE ",I,?24,"000.00",?31,"000",?35,"00",?39,"  0000.00"

 +2        WRITE !!,"SUBTOTAL",?39," 00000.00"

 +3        FOR I=1:1

               IF $Y=30

                   QUIT 

               WRITE !

 +4        WRITE !!,"TOTAL",?39," 00000.00"

 +5        FOR I=1:1

               IF $Y=40

                   QUIT 

               WRITE !

 +6        FOR I=1:1:3

               WRITE !,"PAYER ",I,?24,"X",?27,"X"

 +7        FOR I=1:1

               IF $Y=45

                   QUIT 

               WRITE !

 +8        FOR I=1:1:3

               WRITE !,"INSURED NAME ",I,?23,"X",?26,"XX",?29,"POLICY # ",I,?46,"GROUP NAME ",I,?61,"GROUP # ",I

 +9        FOR I=1:1

               IF $Y=50

                   QUIT 

               WRITE !

 +10       WRITE "X",?2,"X",?4,"EMPLOYER NAME",?42,"CITY  STATE  ZIP"

 +11       FOR I=1:1

               IF $Y=53

                   QUIT 

               WRITE !

 +12       WRITE "PRINCIPAL DIAGNOSIS",?44,"CODE"

           FOR I=51,58,65,72

               WRITE ?I,"CODE"

 +13       WRITE !!,"X",?3,"PRINCIPAL PROCEDURE",?44,"CODE",?51,"DATE",?57,"CODE",?63,"DATE",?68,"CODE",?74,"DATE"

 +14       FOR I=1:1

               IF $Y=56

                   QUIT 

               WRITE !

 +15       WRITE !?22,"TX. AUTH.",?33,"Dept. Veterans Affairs",?56,"F. L. 93"

 +16       WRITE !!,"Patient ID: ","XXXXXXXXX",!,"Bill Type: ","XXXX XXXXXXX",!,"UB-82 TEST PATTERN",!,"**TEST PATTERN**"

16         FOR I=1:1

               IF $Y=62

                   QUIT 

               WRITE !

 +1        WRITE ?46,"UB-82 SIGNER NAME",!,?46,"UB-82 SIGNER TITLE",?69,"DATE"

 +2        KILL I

 +3        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

               QUIT 

 +4        DO ^%ZISC

 +5       ;***

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

 +7        QUIT 

 +8       ;IBCF1TP