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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCF1TP 2502 printed Nov 22, 2024@17:22:55 Page 2
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
