- IBCF2TP ;ALB/RLW - HCFA 1500 12-90 TEST PATTERN ; 1-JAN-92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ZIS ;
- ;***
- ;S XRTL=$ZU(0),XRTN="IBCF2TP-1" D T0^%ZOSV ;start rt clock
- ;S DGPGM="PRINT^IBCF2TP",DGVAR="^" D ZIS^DGUTQ I POP G Q
- S %ZIS="QM" D ^%ZIS G:POP Q
- I $D(IO("Q")) K IO("Q") S ZTRTN="PRINT^IBCF2TP",ZTDESC="IB - TEST HCFA 1500 PRINT" D ^%ZTLOAD K ZTSK D HOME^%ZIS G Q
- U IO
- D PRINT
- Q K DGPGM,DGVAR,POP,IBADDM
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCF2TP" D T1^%ZOSV ;stop rt clock
- Q
- PRINT ; print test pattern
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCF2TP" D T1^%ZOSV ;stop rt clock
- ;S XRTL=$ZU(0),XRTN="IBCF2TP-2" D T0^%ZOSV ;start rt clock
- N X S X=""
- CARRIER ;
- S IBADDM=+$P($G(^IBE(350.9,1,1)),U,27)
- W:$E(IOST,1,2)["C-" @IOF W !,?IBADDM,"INSURANCE CARRIER NAME",!?IBADDM,"CARRIER ADDRESS LINE 1",!?IBADDM,"CARRIER ADDRESS LINE 2",!?IBADDM,"CARRIER ADDRESS LINE 3",!?IBADDM,"CARRIER CITY, STATE ZIP"
- LINE2 W !!!,X,?7,X,?14,X,?23,X,?30,X,?38,X,?44,X,?49,"SUBSCRIBER ID#"
- LINE4 W !!,"PATIENT NAME",?30,"MM DD YY",?41,X,?46,X,?49,"INSURED'S NAME"
- LINE6 W !!,"PATIENT ADDRESS STREET",?32,X,?37,X,?41,X,?46,X,?49,"INSURED'S ADDRESS STREET"
- LINE8 W !!,"PATIENT ADDRESS CITY",?25,"ST",?34,X,?40,X,?46,X,?49,"INSURED'S ADDRESS CITY",?73,"ST"
- LINE10 W !!,"PT ZIP CODE",?14,"999",?18,"999-9999",?34,X,?40,X,?46,X,?49,"INS ZIP CODE",?64,"999",?68,"999-9999"
- LINE12 W !!,"OTHER INSURED'S NAME",?49,"INSURED'S POLICY GROUP"
- LINE14 W !!,"OTHER POLICY NUMBER",?34,X,?40,X,?53,"MM DD YY",?67,X,?74,X
- LINE16 W !!,?1,"MM DD YY",?17,X,?23,X,?34,X,?40,X,?44,"ST",?49,"INSURED'S EMPLOYER"
- LINE18 W !!,"OTHER'S EMPLOYER",?34,X,?40,X,?49,"INSURANCE PLAN NAME"
- LINE20 W !!,"OTHER'S INSURANCE PLAN",?51,X,?56,X
- LINE26 W !!!!!!,?1,"MM DD YY",?36,"MM DD YY",?53,"MM DD YY",?67,"MM DD YY"
- LINE28 W !!,"REFERRING PHYSICIAN",?27,"PHYSICIAN ID",?53,"MM DD YY",?67,"MM DD YY"
- LINE30 W !!,?51,X,?56,X,?61,"9999.99",?70,"9999.99"
- LINE32 W !!,?2,"X99.99",?29,"X99.99"
- LINE34 W !!,?2,"X99.99",?29,"X99.99"
- LINE38 ;lines 38,40,42,44,46,48 all the same
- W !!
- F I=1:1:6 W !!,"MM DD YY",?9,"MM DD YY",?18,X,?21,X,?25,"CPT",?32,"MODIF",?41,"DIAG",?50,"9999.99",?58,X,?61,X,?64,X,?67,X,?70,"BC/BS#"
- LINE50 W !!,"FEDERAL TAX ID",?18,X,?22,"PAT ACCT#",?37,X,?42,X,?52,"9999.99",?62,"9999.99",?71,"9999.99"
- LINE52 W !!,?22,"VAMC",?49,"AGENT CASHIER (999) 999-9999"
- LINE53 W !,?22,"STREET ADDRESS",?49,"STREET ADDRESS"
- LINE54 W !,?22,"CITY, STATE ZIP",?49,"CITY, STATE ZIP"
- I $D(ZTQUEUED) S ZTREQ="@" Q
- D ^%ZISC
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCF2TP" D T1^%ZOSV ;stop rt clock
- Q
- IBCF2TP ;ALB/RLW - HCFA 1500 12-90 TEST PATTERN ; 1-JAN-92
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ZIS ;
- +1 ;***
- +2 ;S XRTL=$ZU(0),XRTN="IBCF2TP-1" D T0^%ZOSV ;start rt clock
- +3 ;S DGPGM="PRINT^IBCF2TP",DGVAR="^" D ZIS^DGUTQ I POP G Q
- +4 SET %ZIS="QM"
- DO ^%ZIS
- IF POP
- GOTO Q
- +5 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="PRINT^IBCF2TP"
- SET ZTDESC="IB - TEST HCFA 1500 PRINT"
- DO ^%ZTLOAD
- KILL ZTSK
- DO HOME^%ZIS
- GOTO Q
- +6 USE IO
- +7 DO PRINT
- Q KILL DGPGM,DGVAR,POP,IBADDM
- +1 ;***
- +2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCF2TP" D T1^%ZOSV ;stop rt clock
- +3 QUIT
- PRINT ; print test pattern
- +1 ;***
- +2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCF2TP" D T1^%ZOSV ;stop rt clock
- +3 ;S XRTL=$ZU(0),XRTN="IBCF2TP-2" D T0^%ZOSV ;start rt clock
- +4 NEW X
- SET X=""
- CARRIER ;
- +1 SET IBADDM=+$PIECE($GET(^IBE(350.9,1,1)),U,27)
- +2 IF $EXTRACT(IOST,1,2)["C-"
- WRITE @IOF
- WRITE !,?IBADDM,"INSURANCE CARRIER NAME",!?IBADDM,"CARRIER ADDRESS LINE 1",!?IBADDM,"CARRIER ADDRESS LINE 2",!?IBADDM,"CARRIER ADDRESS LINE 3",!?IBADDM,"CARRIER CITY, STATE ZIP"
- LINE2 WRITE !!!,X,?7,X,?14,X,?23,X,?30,X,?38,X,?44,X,?49,"SUBSCRIBER ID#"
- LINE4 WRITE !!,"PATIENT NAME",?30,"MM DD YY",?41,X,?46,X,?49,"INSURED'S NAME"
- LINE6 WRITE !!,"PATIENT ADDRESS STREET",?32,X,?37,X,?41,X,?46,X,?49,"INSURED'S ADDRESS STREET"
- LINE8 WRITE !!,"PATIENT ADDRESS CITY",?25,"ST",?34,X,?40,X,?46,X,?49,"INSURED'S ADDRESS CITY",?73,"ST"
- LINE10 WRITE !!,"PT ZIP CODE",?14,"999",?18,"999-9999",?34,X,?40,X,?46,X,?49,"INS ZIP CODE",?64,"999",?68,"999-9999"
- LINE12 WRITE !!,"OTHER INSURED'S NAME",?49,"INSURED'S POLICY GROUP"
- LINE14 WRITE !!,"OTHER POLICY NUMBER",?34,X,?40,X,?53,"MM DD YY",?67,X,?74,X
- LINE16 WRITE !!,?1,"MM DD YY",?17,X,?23,X,?34,X,?40,X,?44,"ST",?49,"INSURED'S EMPLOYER"
- LINE18 WRITE !!,"OTHER'S EMPLOYER",?34,X,?40,X,?49,"INSURANCE PLAN NAME"
- LINE20 WRITE !!,"OTHER'S INSURANCE PLAN",?51,X,?56,X
- LINE26 WRITE !!!!!!,?1,"MM DD YY",?36,"MM DD YY",?53,"MM DD YY",?67,"MM DD YY"
- LINE28 WRITE !!,"REFERRING PHYSICIAN",?27,"PHYSICIAN ID",?53,"MM DD YY",?67,"MM DD YY"
- LINE30 WRITE !!,?51,X,?56,X,?61,"9999.99",?70,"9999.99"
- LINE32 WRITE !!,?2,"X99.99",?29,"X99.99"
- LINE34 WRITE !!,?2,"X99.99",?29,"X99.99"
- LINE38 ;lines 38,40,42,44,46,48 all the same
- +1 WRITE !!
- +2 FOR I=1:1:6
- WRITE !!,"MM DD YY",?9,"MM DD YY",?18,X,?21,X,?25,"CPT",?32,"MODIF",?41,"DIAG",?50,"9999.99",?58,X,?61,X,?64,X,?67,X,?70,"BC/BS#"
- LINE50 WRITE !!,"FEDERAL TAX ID",?18,X,?22,"PAT ACCT#",?37,X,?42,X,?52,"9999.99",?62,"9999.99",?71,"9999.99"
- LINE52 WRITE !!,?22,"VAMC",?49,"AGENT CASHIER (999) 999-9999"
- LINE53 WRITE !,?22,"STREET ADDRESS",?49,"STREET ADDRESS"
- LINE54 WRITE !,?22,"CITY, STATE ZIP",?49,"CITY, STATE ZIP"
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +2 DO ^%ZISC
- +3 ;***
- +4 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCF2TP" D T1^%ZOSV ;stop rt clock
- +5 QUIT
