- 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 Feb 19, 2025@00:03:24 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