IBYPSP4 ;ALB/CXW-IB*2.0*427 POST INIT: UPDATE REVENUE CODE CPT LINKS ; 01/12/10
;;2.0;INTEGRATED BILLING;**427**;21-MAR-94;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; continue to add Revenue Codes - CPT links
N IBI,IBJ,IBTX,IBLN
F IBI=1:1 S IBTX=$P($T(FRVL4+IBI),";;",2) Q:IBTX="" D
. F IBJ=1:1 S IBLN=$P(IBTX,",",IBJ) Q:IBLN="" D RVLA^IBYPSP1
Q
FRVL4 ; revenue code - CPT links
;;636^J2941^,636^J2993^,636^J2995^,636^J2997^,636^J3010^,
;;636^J3030^,636^J3101^,636^J3240^J3243,636^J3300^,636^J3355^,
;;636^J3396^,636^J3465^,636^J3473^,636^J3487^J3488,636^J7030^J7050,
;;636^J7060^J7070,636^J7100^J7130,636^J7190^,636^J7308^,636^J7321^,
;;636^J7323^J7324,636^J7502^,636^J7504^J7505,636^J7507^,636^J7513^,
;;636^J7516^,636^J8501^,636^J8520^J8521,636^J8560^,636^J8705^,
;;636^J9001^J9027,636^J9031^J9035,636^J9041^,636^J9050^J9055,636^J9065^,
;;636^J9093^,636^J9098^,636^J9120^,636^J9150^,636^J9170^,
;;636^J9178^,636^J9185^,636^J9200^J9209,636^J9211^,636^J9213^J9219,
;;636^J9225^,636^J9260^,636^J9263^J9265,636^J9268^,636^J9280^J9293,
;;636^J9300^J9320,636^J9330^J9355,636^J9390^J9395,636^P9041^,636^P9045^P9047,
;;636^Q0112^,636^Q0144^,636^Q0163^Q0166,636^Q0169^Q0170,636^Q0175^,
;;636^Q0177^,636^Q0179^Q0181,636^Q1003^,636^Q2009^,636^Q3031^,
;;636^Q4101^Q4102,636^Q4106^,636^Q4112^,636^Q9954^,636^Q9965^Q9967,
;;640^S9328^S9330,640^S9346^,640^S9348^,640^S9366^S9367,640^S9379^,
;;640^S9490^S9494,640^S9500^S9504,640^S9529^,640^S9537^,640^S9542^,
;;640^S9560^,649^S5497^S5502,651^Q5001^,651^T2042^,660^S5150^,
;;720^59000^,720^59015^,720^59025^,720^59200^,720^59320^,
;;720^59400^59412,720^59510^59515,720^59618^,730^93000^93010,730^93014^,
;;730^93040^93042,730^93272^,730^R0076^,731^93025^,731^93224^93237,
;;731^93268^,731^93270^93271,731^93278^,732^93012^,740^95805^95816,
;;740^95819^,740^95822^,740^95824^,740^95830^,740^95951^,
;;740^95954^,740^95956^,740^95958^,740^95966^,740^95999^,
;;740^G0400^,750^43273^,750^43280^,750^43289^,750^43450^,
;;750^43453^,750^43456^43458,750^44500^,750^45915^45999,750^46020^46030,
;;750^46040^46050,750^91020^,750^91052^,750^91065^,750^91105^91111,
;;750^91122^91123,750^91299^,750^G0104^G0105,750^G0121^,760^31502^31505,
;;760^A6240^,760^G0382^,761^26432^,761^26650^,761^26705^,
;;761^26720^26727,761^27025^,761^27030^,761^27095^,761^27323^27324,
;;761^27495^,761^27552^,761^27603^,761^27605^,761^27613^,
;;761^27760^,761^27824^27825,761^28190^,761^28405^,761^28476^,
;;761^28515^,761^29893^,761^30000^30020,761^30110^,761^30220^30300,
;;761^30400^,761^30520^,761^30560^30630,761^30801^30802,761^30905^30906,
;;761^31000^,761^31020^,761^31200^31201,761^31231^31240,761^31254^31256,
;;761^31267^,761^31276^,761^31287^31291,761^31510^31511,761^31513^31526,
;;761^31528^,761^31530^31545,761^31575^31579,761^31615^31620,761^31622^31625,
;;761^31628^31630,761^31632^31645,761^46900^46916,761^49080^49081,761^49180^,
;;761^49400^,761^50386^,761^63057^,761^64530^,761^67700^,
;;761^67800^67805,761^67825^,761^67840^67880,761^67901^,761^67908^,
;;761^67912^67922,761^67938^67966,761^68020^,761^68110^,761^68320^,
;;761^68399^,761^68816^,761^69000^,761^69100^,761^90386^,
;;761^6045F^,761^A4262^,761^G0122^,761^Q4110^,762^99217^99220,
;;762^99234^99236,762^G0379^,771^90471^90473,771^G0008^G0010,820^90940^,
;;821^90935^90937,821^90999^,822^A4660^A4671,822^A4690^,822^A4706^A4707,
;;822^A4709^,822^A4714^,822^A4722^,822^A4730^,822^A4740^A4760,
;;822^A4770^,822^A4772^,822^A4911^,822^A4913^,822^A4927^A4931,
;;822^E1636^,823^E1594^,825^90956^,825^90960^90962,825^E1600^,
;;831^90945^90947,835^90966^,835^90970^,900^90801^90802,900^90875^,
;;901^90865^90870,903^90814^,904^G0176^,914^90804^90813,914^90816^90819,
;;914^90821^90824,914^90826^90827,914^90829^,914^90845^,914^90862^,
;;914^96152^,914^M0064^,915^90853^,915^90857^,915^96153^,
;;916^90846^90849,916^90887^,916^96154^96155,918^96101^96103,918^96110^96111,
;;918^96116^,918^96118^96151,920^92020^,920^92060^92065,920^92081^92250,
;;920^92265^92275,920^92283^92287,920^93279^93299,920^93720^,920^93722^,
;;920^93740^,920^93784^93790,920^93799^,920^93982^93990,920^95250^95251,
;;920^95857^,920^95928^,920^95970^,920^95972^,920^95978^,
;;920^95981^,920^96000^,920^96002^,920^96004^,920^99172^99173,
;;921^93721^,921^93770^,921^93875^93888,921^93892^,921^93922^93931,
;;921^93965^93981,922^95860^95865,922^95867^95874,922^95900^,922^95904^,
;;922^95921^,922^95923^,922^95926^,922^95930^,922^95934^,
;;922^95937^,922^95974^,922^S3900^,923^P3001^,923^Q0091^,
;;924^95004^,924^95010^,924^95012^,924^95015^,924^95024^95028,
;;924^95044^,924^95052^,924^95060^95075,924^95115^,924^95120^95132,
;;924^95144^95149,924^95199^,929^0181T^,929^G0255^,940^96040^,
;;940^96567^,940^96900^96921,940^96999^,940^98941^,940^99195^99199,
;;940^0101T^,940^M0076^,942^98960^98968,942^99078^,942^G0108^G0109,
;;942^H2014^,942^S5109^,942^S5111^,942^S9075^,942^S9140^S9141,
;;942^S9445^S9446,942^S9449^,942^S9452^S9470,943^93797^93798,960^99221^99233,
;;960^99238^99239,960^99288^,960^99291^99292,960^99324^99327,960^G0179^,
;;960^G0181^,963^99100^99140,963^99143^99145,963^99149^99150,963^00100^,
;;963^00103^00104,963^00120^00126,963^00140^00145,963^00147^,963^00160^00164,
;;963^00170^,963^00176^,963^00190^00192,963^00210^00218,963^00220^,
;;963^00300^,963^00320^00326,963^00350^00352,963^00400^00406,963^00410^,
;;963^00450^,963^00470^00472,963^00500^,963^00520^00524,963^00528^00529,
;;963^00530^00539,963^00540^00542,963^00546^00548,963^00550^,963^00560^,
;;963^00562^00567,963^00600^00604,963^00620^00625,963^00630^,963^00635^,
;;963^00640^,963^00670^,963^00700^00702,963^00740^,963^00750^00752,
;;963^00756^,963^00770^,963^00790^00797,963^00800^00802,963^00810^,
;;963^00820^,963^00830^00836,963^00840^00848,963^00851^,963^00860^00868,
;;963^00870^00873,963^00880^00882,963^00902^00904,963^00908^,963^00910^00918,
;;963^00920^00928,963^00930^,963^00938^,963^00940^00944,963^00948^,
;;963^00952^,963^01112^,963^01120^,963^01150^,963^01160^,
;;963^01200^01202,963^01210^01232,963^01250^01260,963^01270^01274,963^01320^,
;;963^01340^,963^01360^,963^01380^01382,963^01392^01404,963^01420^,
;;963^01430^01432,963^01440^,963^01444^,963^01462^01464,963^01470^01472,
;;963^01480^01486,963^01500^01502,963^01520^01522,963^01610^,963^01620^01622,
;;963^01630^,963^01638^,963^01650^,963^01654^01656,963^01710^01712,
;;963^01716^,963^01730^,963^01740^01744,963^01760^,963^01770^01772,
;;963^01780^,963^01810^,963^01820^01829,963^01830^,963^01840^,
;;963^01844^,963^01850^,963^01916^,963^01922^01926,963^01930^,
;;963^01935^01936,963^01951^,963^01961^,963^01963^,963^01967^01968,
;;963^01991^01992,963^01996^01999,969^99056^99060,969^99075^,969^99080^99091,
;;969^99334^99348,969^99363^99368,969^99429^,969^99441^99443,969^99450^99456,
;;969^99462^,969^3083F^,974^90889^,975^0078T^,982^99374^99375,
;;982^99378^99379,982^99381^99384,982^99392^99394,982^99403^,982^99411^,
;;982^99420^,982^G0250^,982^G0337^,987^99251^99255,987^99304^99310
;;987^99315^99318,987^99356^99359,
;;
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYPSP4 7199 printed Apr 09, 2024@21:09:03 Page 2
IBYPSP4 ;ALB/CXW-IB*2.0*427 POST INIT: UPDATE REVENUE CODE CPT LINKS ; 01/12/10
+1 ;;2.0;INTEGRATED BILLING;**427**;21-MAR-94;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; continue to add Revenue Codes - CPT links
+5 NEW IBI,IBJ,IBTX,IBLN
+6 FOR IBI=1:1
SET IBTX=$PIECE($TEXT(FRVL4+IBI),";;",2)
if IBTX=""
QUIT
Begin DoDot:1
+7 FOR IBJ=1:1
SET IBLN=$PIECE(IBTX,",",IBJ)
if IBLN=""
QUIT
DO RVLA^IBYPSP1
End DoDot:1
+8 QUIT
FRVL4 ; revenue code - CPT links
+1 ;;636^J2941^,636^J2993^,636^J2995^,636^J2997^,636^J3010^,
+2 ;;636^J3030^,636^J3101^,636^J3240^J3243,636^J3300^,636^J3355^,
+3 ;;636^J3396^,636^J3465^,636^J3473^,636^J3487^J3488,636^J7030^J7050,
+4 ;;636^J7060^J7070,636^J7100^J7130,636^J7190^,636^J7308^,636^J7321^,
+5 ;;636^J7323^J7324,636^J7502^,636^J7504^J7505,636^J7507^,636^J7513^,
+6 ;;636^J7516^,636^J8501^,636^J8520^J8521,636^J8560^,636^J8705^,
+7 ;;636^J9001^J9027,636^J9031^J9035,636^J9041^,636^J9050^J9055,636^J9065^,
+8 ;;636^J9093^,636^J9098^,636^J9120^,636^J9150^,636^J9170^,
+9 ;;636^J9178^,636^J9185^,636^J9200^J9209,636^J9211^,636^J9213^J9219,
+10 ;;636^J9225^,636^J9260^,636^J9263^J9265,636^J9268^,636^J9280^J9293,
+11 ;;636^J9300^J9320,636^J9330^J9355,636^J9390^J9395,636^P9041^,636^P9045^P9047,
+12 ;;636^Q0112^,636^Q0144^,636^Q0163^Q0166,636^Q0169^Q0170,636^Q0175^,
+13 ;;636^Q0177^,636^Q0179^Q0181,636^Q1003^,636^Q2009^,636^Q3031^,
+14 ;;636^Q4101^Q4102,636^Q4106^,636^Q4112^,636^Q9954^,636^Q9965^Q9967,
+15 ;;640^S9328^S9330,640^S9346^,640^S9348^,640^S9366^S9367,640^S9379^,
+16 ;;640^S9490^S9494,640^S9500^S9504,640^S9529^,640^S9537^,640^S9542^,
+17 ;;640^S9560^,649^S5497^S5502,651^Q5001^,651^T2042^,660^S5150^,
+18 ;;720^59000^,720^59015^,720^59025^,720^59200^,720^59320^,
+19 ;;720^59400^59412,720^59510^59515,720^59618^,730^93000^93010,730^93014^,
+20 ;;730^93040^93042,730^93272^,730^R0076^,731^93025^,731^93224^93237,
+21 ;;731^93268^,731^93270^93271,731^93278^,732^93012^,740^95805^95816,
+22 ;;740^95819^,740^95822^,740^95824^,740^95830^,740^95951^,
+23 ;;740^95954^,740^95956^,740^95958^,740^95966^,740^95999^,
+24 ;;740^G0400^,750^43273^,750^43280^,750^43289^,750^43450^,
+25 ;;750^43453^,750^43456^43458,750^44500^,750^45915^45999,750^46020^46030,
+26 ;;750^46040^46050,750^91020^,750^91052^,750^91065^,750^91105^91111,
+27 ;;750^91122^91123,750^91299^,750^G0104^G0105,750^G0121^,760^31502^31505,
+28 ;;760^A6240^,760^G0382^,761^26432^,761^26650^,761^26705^,
+29 ;;761^26720^26727,761^27025^,761^27030^,761^27095^,761^27323^27324,
+30 ;;761^27495^,761^27552^,761^27603^,761^27605^,761^27613^,
+31 ;;761^27760^,761^27824^27825,761^28190^,761^28405^,761^28476^,
+32 ;;761^28515^,761^29893^,761^30000^30020,761^30110^,761^30220^30300,
+33 ;;761^30400^,761^30520^,761^30560^30630,761^30801^30802,761^30905^30906,
+34 ;;761^31000^,761^31020^,761^31200^31201,761^31231^31240,761^31254^31256,
+35 ;;761^31267^,761^31276^,761^31287^31291,761^31510^31511,761^31513^31526,
+36 ;;761^31528^,761^31530^31545,761^31575^31579,761^31615^31620,761^31622^31625,
+37 ;;761^31628^31630,761^31632^31645,761^46900^46916,761^49080^49081,761^49180^,
+38 ;;761^49400^,761^50386^,761^63057^,761^64530^,761^67700^,
+39 ;;761^67800^67805,761^67825^,761^67840^67880,761^67901^,761^67908^,
+40 ;;761^67912^67922,761^67938^67966,761^68020^,761^68110^,761^68320^,
+41 ;;761^68399^,761^68816^,761^69000^,761^69100^,761^90386^,
+42 ;;761^6045F^,761^A4262^,761^G0122^,761^Q4110^,762^99217^99220,
+43 ;;762^99234^99236,762^G0379^,771^90471^90473,771^G0008^G0010,820^90940^,
+44 ;;821^90935^90937,821^90999^,822^A4660^A4671,822^A4690^,822^A4706^A4707,
+45 ;;822^A4709^,822^A4714^,822^A4722^,822^A4730^,822^A4740^A4760,
+46 ;;822^A4770^,822^A4772^,822^A4911^,822^A4913^,822^A4927^A4931,
+47 ;;822^E1636^,823^E1594^,825^90956^,825^90960^90962,825^E1600^,
+48 ;;831^90945^90947,835^90966^,835^90970^,900^90801^90802,900^90875^,
+49 ;;901^90865^90870,903^90814^,904^G0176^,914^90804^90813,914^90816^90819,
+50 ;;914^90821^90824,914^90826^90827,914^90829^,914^90845^,914^90862^,
+51 ;;914^96152^,914^M0064^,915^90853^,915^90857^,915^96153^,
+52 ;;916^90846^90849,916^90887^,916^96154^96155,918^96101^96103,918^96110^96111,
+53 ;;918^96116^,918^96118^96151,920^92020^,920^92060^92065,920^92081^92250,
+54 ;;920^92265^92275,920^92283^92287,920^93279^93299,920^93720^,920^93722^,
+55 ;;920^93740^,920^93784^93790,920^93799^,920^93982^93990,920^95250^95251,
+56 ;;920^95857^,920^95928^,920^95970^,920^95972^,920^95978^,
+57 ;;920^95981^,920^96000^,920^96002^,920^96004^,920^99172^99173,
+58 ;;921^93721^,921^93770^,921^93875^93888,921^93892^,921^93922^93931,
+59 ;;921^93965^93981,922^95860^95865,922^95867^95874,922^95900^,922^95904^,
+60 ;;922^95921^,922^95923^,922^95926^,922^95930^,922^95934^,
+61 ;;922^95937^,922^95974^,922^S3900^,923^P3001^,923^Q0091^,
+62 ;;924^95004^,924^95010^,924^95012^,924^95015^,924^95024^95028,
+63 ;;924^95044^,924^95052^,924^95060^95075,924^95115^,924^95120^95132,
+64 ;;924^95144^95149,924^95199^,929^0181T^,929^G0255^,940^96040^,
+65 ;;940^96567^,940^96900^96921,940^96999^,940^98941^,940^99195^99199,
+66 ;;940^0101T^,940^M0076^,942^98960^98968,942^99078^,942^G0108^G0109,
+67 ;;942^H2014^,942^S5109^,942^S5111^,942^S9075^,942^S9140^S9141,
+68 ;;942^S9445^S9446,942^S9449^,942^S9452^S9470,943^93797^93798,960^99221^99233,
+69 ;;960^99238^99239,960^99288^,960^99291^99292,960^99324^99327,960^G0179^,
+70 ;;960^G0181^,963^99100^99140,963^99143^99145,963^99149^99150,963^00100^,
+71 ;;963^00103^00104,963^00120^00126,963^00140^00145,963^00147^,963^00160^00164,
+72 ;;963^00170^,963^00176^,963^00190^00192,963^00210^00218,963^00220^,
+73 ;;963^00300^,963^00320^00326,963^00350^00352,963^00400^00406,963^00410^,
+74 ;;963^00450^,963^00470^00472,963^00500^,963^00520^00524,963^00528^00529,
+75 ;;963^00530^00539,963^00540^00542,963^00546^00548,963^00550^,963^00560^,
+76 ;;963^00562^00567,963^00600^00604,963^00620^00625,963^00630^,963^00635^,
+77 ;;963^00640^,963^00670^,963^00700^00702,963^00740^,963^00750^00752,
+78 ;;963^00756^,963^00770^,963^00790^00797,963^00800^00802,963^00810^,
+79 ;;963^00820^,963^00830^00836,963^00840^00848,963^00851^,963^00860^00868,
+80 ;;963^00870^00873,963^00880^00882,963^00902^00904,963^00908^,963^00910^00918,
+81 ;;963^00920^00928,963^00930^,963^00938^,963^00940^00944,963^00948^,
+82 ;;963^00952^,963^01112^,963^01120^,963^01150^,963^01160^,
+83 ;;963^01200^01202,963^01210^01232,963^01250^01260,963^01270^01274,963^01320^,
+84 ;;963^01340^,963^01360^,963^01380^01382,963^01392^01404,963^01420^,
+85 ;;963^01430^01432,963^01440^,963^01444^,963^01462^01464,963^01470^01472,
+86 ;;963^01480^01486,963^01500^01502,963^01520^01522,963^01610^,963^01620^01622,
+87 ;;963^01630^,963^01638^,963^01650^,963^01654^01656,963^01710^01712,
+88 ;;963^01716^,963^01730^,963^01740^01744,963^01760^,963^01770^01772,
+89 ;;963^01780^,963^01810^,963^01820^01829,963^01830^,963^01840^,
+90 ;;963^01844^,963^01850^,963^01916^,963^01922^01926,963^01930^,
+91 ;;963^01935^01936,963^01951^,963^01961^,963^01963^,963^01967^01968,
+92 ;;963^01991^01992,963^01996^01999,969^99056^99060,969^99075^,969^99080^99091,
+93 ;;969^99334^99348,969^99363^99368,969^99429^,969^99441^99443,969^99450^99456,
+94 ;;969^99462^,969^3083F^,974^90889^,975^0078T^,982^99374^99375,
+95 ;;982^99378^99379,982^99381^99384,982^99392^99394,982^99403^,982^99411^,
+96 ;;982^99420^,982^G0250^,982^G0337^,987^99251^99255,987^99304^99310
+97 ;;987^99315^99318,987^99356^99359,
+98 ;;
+99 ;
+100 QUIT
