Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ICPT63PT

ICPT63PT.m

Go to the documentation of this file.
  1. ICPT63PT ;ALB/ESD - CPT Update '98 Post-Init Driver; 1/29/98
  1. ;;6.0;CPT/HCPCS;**3**;May 19, 1997
  1. ;
  1. EN ;- Main entry point
  1. ;
  1. ;- Modify CPT Copyright file (#81.2)
  1. D DISTUP
  1. ;
  1. ;- Add, revise, inactivate categories in the CPT Category file (#81.1)
  1. D CATUPD
  1. ;
  1. ;- Add, revise, inactivate modifiers in the CPT Modifier file (#81.3)
  1. D EN^ICPT63P2
  1. ;
  1. ;- Reminder message to users to reload the ^ICPT global
  1. D MES^XPDUTL("")
  1. D BMES^XPDUTL("****** YOU MUST LOAD THE CPT GLOBAL (^ICPT) FROM THE FILE ICPT6_3.GBL")
  1. D MES^XPDUTL("UPON COMPLETION OF THIS INSTALLATION! ******")
  1. D MES^XPDUTL("")
  1. ENQ Q
  1. ;
  1. ;
  1. DISTUP ;- Entry point for Distribution Date update
  1. ;
  1. D MES^XPDUTL("")
  1. D BMES^XPDUTL(">>> Updating Distribution Date in the CPT Copyright file (#81.2)......")
  1. I '$$DISTDT D G DISTUPQ
  1. . D BMES^XPDUTL(">>> Error updating Distribution Date field in CPT Copyright file (#81.2).")
  1. D MES^XPDUTL("......completed.")
  1. DISTUPQ Q
  1. ;
  1. ;
  1. DISTDT() ;- Add distribution date to file #81.2
  1. N DIC,DIE,DR,X,Y
  1. S DIC="^DIC(81.2,"
  1. S DIC(0)="OX"
  1. ;
  1. ;- Get entry (currently only one entry exists in this file)
  1. S X="CPT MESSAGE"
  1. D ^DIC
  1. I +Y=-1 G DISTDTQ
  1. ;
  1. ;- Add date
  1. S DA=+Y
  1. S DIE=DIC
  1. S DR=".02///2980201"
  1. D ^DIE
  1. DISTDTQ Q $S(+$G(DA)>0:1,1:0)
  1. ;
  1. ;
  1. CATUPD ;- Entry point for CPT Category update
  1. ;
  1. N CATEG,CATI,PRTFLG
  1. S PRTFLG=""
  1. D BMES^XPDUTL(">>> Updating CPT Category file (#81.1)......")
  1. ;
  1. ;- Get category record from list
  1. F CATI=1:1 S CATEG=$P($T(CATS+CATI),";;",2) Q:CATEG="QUIT" D
  1. . ;
  1. . ;- Display heading on screen once
  1. . I (PRTFLG'=$P(CATEG,"^")) D @($S($P(CATEG,"^")="A":"AMSG",$P(CATEG,"^")="M":"MMSG",1:"IMSG"))
  1. . ;
  1. . ;- Determine if record will be added, modified, or inactivated
  1. . D @($S($P(CATEG,"^")="A":"ADD",$P(CATEG,"^")="M":"MOD",1:"INACT"))
  1. D BMES^XPDUTL("...... completed.")
  1. CATUPDQ Q
  1. ;
  1. ;
  1. MOD ;- Update CPT Category file (#81.1) with modified names/CPT ranges
  1. ;
  1. N CATIEN,CATNODE,CATNNDE
  1. S CATIEN=0,(CATNODE,CATNNDE)=""
  1. ;
  1. ;- Get pieces 1-63 of "B" xref to handle lookup of long names
  1. S CATIEN=+$O(^DIC(81.1,"B",$E($P(CATEG,"^",2),1,63),0))
  1. ;
  1. ;- Display error message if no IEN
  1. I 'CATIEN D ERRMSG("M"),SETFLG Q
  1. S CATNODE=$G(^DIC(81.1,CATIEN,0)) Q:CATNODE=""
  1. ;
  1. ;- Edit record
  1. S DIE="^DIC(81.1,",DA=CATIEN,DR=".01///"_$P(CATEG,"^",3)_";4///"_$P(CATEG,"^",6)_";5///"_$P(CATEG,"^",7)
  1. D ^DIE K DA,DIE,DR
  1. ;
  1. ;- Get new node and display old and modified values of record to screen
  1. S CATNNDE=$G(^DIC(81.1,CATIEN,0))
  1. D BMES^XPDUTL("Old Name: "_$P(CATNODE,"^")_" Range: "_$P(CATNODE,"^",4)_"-"_$P(CATNODE,"^",5))
  1. D MES^XPDUTL("New Name: "_$P(CATNNDE,"^")_" Range: "_$P(CATNNDE,"^",4)_"-"_$P(CATNNDE,"^",5))
  1. D SETFLG
  1. Q
  1. ;
  1. ;
  1. ADD ;- Add new categories to CPT Category file (#81.1)
  1. ;
  1. N CATNNDE,DA,Y
  1. ;
  1. ;- Get pieces 1-63 of "B" xref to handle lookup of long names
  1. I +$O(^DIC(81.1,"B",$E($P(CATEG,"^",2),1,63),0)) D ERRMSG("A"),SETFLG Q
  1. ;
  1. ;- Create new category record
  1. S DIC="^DIC(81.1,",DIC(0)="LZ",DLAYGO=81.1,X=$P(CATEG,"^",2)
  1. K DD,DO D FILE^DICN K DLAYGO,X
  1. ;
  1. ;- Display error message and exit if record was not created
  1. I +Y=-1 D ERRMSG("A"),SETFLG Q
  1. ;
  1. ;- Add new fields to record
  1. S DIE=DIC,DA=+Y,DR="2///"_$P(CATEG,"^",3)_";3///"_$P(CATEG,"^",4)_";4///"_$P(CATEG,"^",5)_";5///"_$P(CATEG,"^",6)_";6///"_$P(CATEG,"^",7)
  1. D ^DIE K DIC,DIE,DR
  1. ;
  1. ;- Display new record to screen
  1. S CATNNDE=$G(^DIC(81.1,DA,0))
  1. D MES^XPDUTL("New Name: "_$P(CATNNDE,"^")_" Range: "_$P(CATNNDE,"^",4)_"-"_$P(CATNNDE,"^",5))
  1. D SETFLG
  1. Q
  1. ;
  1. ;
  1. INACT ;- Inactivate categories from CPT Category file (#81.1)
  1. ;
  1. N CATIEN,CATNODE
  1. S CATIEN=0,CATNODE=""
  1. ;
  1. ;- Get pieces 1-63 of "B" xref to handle lookup of long names
  1. S CATIEN=+$O(^DIC(81.1,"B",$E($P(CATEG,"^",2),1,63),0))
  1. ;
  1. ;- Display error message and exit if record was not found
  1. I 'CATIEN D ERRMSG("I"),SETFLG Q
  1. S CATNODE=$G(^DIC(81.1,CATIEN,0))
  1. S DIE="^DIC(81.1,",DA=CATIEN
  1. ;
  1. ;- Inactivate record
  1. S DR="4///@;5///@;6///@;100///Inactive. Use PSYCHIATRY"_$S(+$O(^DIC(81.1,"B","PSYCHIATRY",0)):" (ien = "_+$O(^DIC(81.1,"B","PSYCHIATRY",0))_")",1:"")
  1. D ^DIE K DA,DIE,DR
  1. ;
  1. ;- Display record to screen
  1. D MES^XPDUTL("Inactivated Name: "_$P(CATNODE,"^"))
  1. D SETFLG
  1. Q
  1. ;
  1. ;
  1. ERRMSG(ACT) ;- Error message for "A"dd, "M"odify, "I"nactivate
  1. ;
  1. N MSG
  1. S MSG=$S(ACT="A":" already exists and could not be added.",ACT="M":" does not exist and could not be modified.",1:" does not exist and could not be inactivated.")
  1. D BMES^XPDUTL("Category "_$P(CATEG,"^",2)_MSG)
  1. Q
  1. ;
  1. ;
  1. AMSG ;- Added categories message
  1. ;
  1. D BMES^XPDUTL("Added Categories:")
  1. D MES^XPDUTL("=================")
  1. D MES^XPDUTL("")
  1. Q
  1. ;
  1. ;
  1. MMSG ;- Modified categories message
  1. ;
  1. D BMES^XPDUTL("Modified Categories:")
  1. D MES^XPDUTL("====================")
  1. Q
  1. ;
  1. ;
  1. IMSG ;- Inactive categories message
  1. ;
  1. D BMES^XPDUTL("Inactive Categories:")
  1. D MES^XPDUTL("====================")
  1. D MES^XPDUTL("")
  1. Q
  1. ;
  1. ;
  1. SETFLG ;- Set print flag so headings will display once
  1. ;
  1. S PRTFLG=$S($P(CATEG,"^")="A":"A",$P(CATEG,"^")="M":"M",1:"I")
  1. Q
  1. ;
  1. ;
  1. CATS ;- CPT Category records
  1. ;;M^MEDICINE^MEDICINE^m^^90000^99199^C
  1. ;;M^MISCELLANEOUS PROCEDURE(S)^OTHER PROCEDURE(S)^s^3^01990^01999^C
  1. ;;M^NON-INVASIVE PERIPHERAL VASCULAR DIAGNOSTIC STUDIES^NON-INVASIVE VASCULAR DIAGNOSTIC STUDIES^s^1^93875^93990^C
  1. ;;M^PHYSICAL MEDICINE^PHYSICAL MEDICINE^s^1^97001^97799^C
  1. ;;M^SPECIAL SERVICES AND REPORTS^SPECIAL SERVICES AND REPORTS^s^1^99000^99090^C
  1. ;;M^ORGAN OR DISEASE ORIENTED PANELS^ORGAN OR DISEASE ORIENTED PANELS^s^5^80049^80092^C
  1. ;;M^SURGICAL PATHOLOGY^SURGICAL PATHOLOGY^s^5^88300^88399^C
  1. ;;M^CARE PLAN OVERSIGHT SERVICES^CARE PLAN OVERSIGHT SERVICES^s^116^99374^99380^C
  1. ;;M^NURSING FACILITY SERVICES^NURSING FACILITY SERVICES^s^116^99301^99316^C
  1. ;;A^OTHER LABORATORY/PATHOLOGY^s^5^89050^89399^C
  1. ;;A^PSYCHIATRY^s^1^90801^90899^C
  1. ;;A^QUALIFYING CIRCUMSTANCES FOR ANESTHESIA^s^1^99100^99140^C
  1. ;;A^SEDATION WITH OR W/O ANALGESIA (CONSCIOUS SEDATION)^s^1^99141^99142^C
  1. ;;A^OTHER SERVICES^s^1^99175^99199^C
  1. ;;I^GENERAL CLINICAL PSYCHIATRIC DIAGNOSTIC OR EVALUATIVE INTERVIEW PROCEDURES^s^1^90801^90801^C
  1. ;;I^SPECIAL CLINICAL PSYCHIATRIC DIAGNOSTIC OR EVALUATIVE PROCEDURES^s^1^90820^90830^C
  1. ;;I^PSYCHIATRIC THERAPEUTIC PROCEDURES^s^1^90835^90899^C
  1. ;;QUIT