| [613] | 1 | IBCF1TP ;ALB/MJB - UB-82 TEST PATTERN PRINT  ;23 SEP 88 13:42 | 
|---|
|  | 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94 | 
|---|
|  | 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
|  | 4 | ; | 
|---|
|  | 5 | ;MAP TO DGCRTP | 
|---|
|  | 6 | ; | 
|---|
|  | 7 | ZIS ; | 
|---|
|  | 8 | ;*** | 
|---|
|  | 9 | ;S XRTL=$ZU(0),XRTN="IBCF1TP-1" D T0^%ZOSV ;start rt clock | 
|---|
|  | 10 | ; | 
|---|
|  | 11 | S %ZIS="QM" D ^%ZIS G:POP Q | 
|---|
|  | 12 | 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 | 
|---|
|  | 13 | U IO | 
|---|
|  | 14 | ;*** | 
|---|
|  | 15 | ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCF1TP" D T1^%ZOSV ;stop rt clock | 
|---|
|  | 16 | ; | 
|---|
|  | 17 | D ENP | 
|---|
|  | 18 | Q I $D(ZTQUEUED) S ZTREQ="@" | 
|---|
|  | 19 | K DGPGM,DGVAR,POP | 
|---|
|  | 20 | ;*** | 
|---|
|  | 21 | ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCF1TP" D T1^%ZOSV ;stop rt clock | 
|---|
|  | 22 | Q | 
|---|
|  | 23 | ENP ; | 
|---|
|  | 24 | ;*** | 
|---|
|  | 25 | ;S XRTL=$ZU(0),XRTN="IBCF1TP-2" D T0^%ZOSV ;start rt clock | 
|---|
|  | 26 | ; | 
|---|
|  | 27 | W @IOF,?24,"*** UB-82 TEST PATTERN ***",!,"AGENT CASHIER",!,"AGENT CASHIER STREET",?24," F. L. 2",?57,"BILL NUMBER",?74,"XXX" | 
|---|
|  | 28 | W !,"CITY STATE  ZIP",!,"PHONE #",?24,"BC/BS #",?38,"FED TAX #",?71,"F. L. 9" | 
|---|
|  | 29 | 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",!! | 
|---|
|  | 30 | W "OC",?3,"DATE" W ?11,"OC",?14,"DATE" W ?22,"OC",?25,"DATE",?35,"OC",?38,"DATE",?46,"OC",?49,"DATE" | 
|---|
|  | 31 | W !,"MAILING ADDRESS NAME",!,"STREET ADDRESS 1",?30,"CC",?33,"CC",?36,"CC",?39,"CC",?42,"CC",?61,"F. L. 45" | 
|---|
|  | 32 | W !,"STREET ADDRESS 2",!,"STREET ADDRESS 3" | 
|---|
|  | 33 | W !,"CITY",?$X+2,"STATE",?$X+2,"ZIP" | 
|---|
|  | 34 | 8 W !!!!,"000 DAYS MEDICAL CARE",! | 
|---|
|  | 35 | F I=1:1:3 W !,"REV CODE ",I,?24,"000.00",?31,"000",?35,"00",?39,"  0000.00" | 
|---|
|  | 36 | W !!,"SUBTOTAL",?39," 00000.00" | 
|---|
|  | 37 | F I=1:1 Q:$Y=30  W ! | 
|---|
|  | 38 | W !!,"TOTAL",?39," 00000.00" | 
|---|
|  | 39 | F I=1:1 Q:$Y=40  W ! | 
|---|
|  | 40 | F I=1:1:3 W !,"PAYER ",I,?24,"X",?27,"X" | 
|---|
|  | 41 | F I=1:1 Q:$Y=45  W ! | 
|---|
|  | 42 | F I=1:1:3 W !,"INSURED NAME ",I,?23,"X",?26,"XX",?29,"POLICY # ",I,?46,"GROUP NAME ",I,?61,"GROUP # ",I | 
|---|
|  | 43 | F I=1:1 Q:$Y=50  W ! | 
|---|
|  | 44 | W "X",?2,"X",?4,"EMPLOYER NAME",?42,"CITY  STATE  ZIP" | 
|---|
|  | 45 | F I=1:1 Q:$Y=53  W ! | 
|---|
|  | 46 | W "PRINCIPAL DIAGNOSIS",?44,"CODE" F I=51,58,65,72 W ?I,"CODE" | 
|---|
|  | 47 | W !!,"X",?3,"PRINCIPAL PROCEDURE",?44,"CODE",?51,"DATE",?57,"CODE",?63,"DATE",?68,"CODE",?74,"DATE" | 
|---|
|  | 48 | F I=1:1 Q:$Y=56  W ! | 
|---|
|  | 49 | W !?22,"TX. AUTH.",?33,"Dept. Veterans Affairs",?56,"F. L. 93" | 
|---|
|  | 50 | W !!,"Patient ID: ","XXXXXXXXX",!,"Bill Type: ","XXXX XXXXXXX",!,"UB-82 TEST PATTERN",!,"**TEST PATTERN**" | 
|---|
|  | 51 | 16 F I=1:1 Q:$Y=62  W ! | 
|---|
|  | 52 | W ?46,"UB-82 SIGNER NAME",!,?46,"UB-82 SIGNER TITLE",?69,"DATE" | 
|---|
|  | 53 | K I | 
|---|
|  | 54 | I $D(ZTQUEUED) S ZTREQ="@" Q | 
|---|
|  | 55 | D ^%ZISC | 
|---|
|  | 56 | ;*** | 
|---|
|  | 57 | ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCF1TP" D T1^%ZOSV ;stop rt clock | 
|---|
|  | 58 | Q | 
|---|
|  | 59 | ;IBCF1TP | 
|---|