IBCF2TP.m

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