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

EC2P120.m

Go to the documentation of this file. 
  1. EC2P120 ;ALB/DE - EC National Update ; 10/4/12 11:00am
  1.  ;;2.0;EVENT CAPTURE;**120**;;Build 2
  1.  ;
  1.  ;this routine is used as a post-init in a KIDS build
  1.  ;to modify the EC National Procedure file #725
  1.  ;
  1.  Q
  1.  ;
  1. START ; entry point for post-init
  1.  ;
  1.  D ADDPROC
  1.  Q
  1.  ;
  1. ADDPROC ;* add procedure to national procedure file
  1.  ;
  1.  ;  Some routine structure is left in place, in the event, additional EC National
  1.  ;  Procedures are desired before the patch is released.
  1.  ;
  1.  ;  ECXX is in format:
  1.  ;   NAME^NATIONAL NUMBER^CPT CODE^FIRST NATIONAL NUMBER SEQUENCE
  1.  ;   LAST NATIONAL NUMBER SEQUENCE
  1.  ;
  1.  N ECX,ECXX,ECDINUM,NAME,CODE,CPT,COUNT,X,Y,DIC,DIE,DA,DR,DLAYGO,DINUM
  1.  N ECADD,ECBEG,ECEND,CODX,NAMX,ECSEQ,LIEN,STR,CPTN,STR
  1.  D MES^XPDUTL(" ")
  1.  D BMES^XPDUTL("Adding new procedures to EC NATIONAL PROCEDURE File (#725)...")
  1.  D MES^XPDUTL(" ")
  1.  S ECDINUM=$O(^EC(725,9999),-1),COUNT=$P(^EC(725,0),U,4)
  1.  F ECX=1:1 S ECXX=$P($T(NEW+ECX),";;",2) Q:ECXX="QUIT"  D
  1.  .S NAME=$P(ECXX,U,1),CODE=$P(ECXX,U,2),CPTN=$P(ECXX,U,3),CODX=CODE
  1.  .S CPT=""
  1.  .I CPTN'="" S CPT=$$FIND1^DIC(81,"","X",CPTN) I +CPT<1 D  Q
  1.  ..S STR="   CPT code "_CPTN_" not a valid code in CPT File."
  1.  ..D MES^XPDUTL(" ")
  1.  ..D BMES^XPDUTL("   ["_CODE_"] "_STR)
  1.  .S ECBEG=$P(ECXX,U,4),ECEND=$P(ECXX,U,5),NAMX=NAME
  1.  .I ECBEG="" S X=NAME D FILPROC Q
  1.  .F ECSEQ=ECBEG:1:ECEND D
  1.  ..S ECADD="000"_ECSEQ,ECADD=$E(ECADD,$L(ECADD)-2,$L(ECADD))
  1.  ..;S NAME=NAMX_ECADD,X=NAME,CODE=CODX_ECADD
  1.  ..I $E(CODX,1,3)'="RCM" S NAME=NAMX_ECSEQ,X=NAME,CODE=CODX_ECADD
  1.  ..E  S NAME=NAMX_$E(ECADD,2,99),X=NAME,CODE=CODX_$E(ECADD,2,99)
  1.  ..D FILPROC
  1.  S $P(^EC(725,0),U,4)=COUNT,X=$O(^EC(725,999999),-1),$P(^EC(725,0),U,3)=X
  1.  Q
  1.  ;
  1. FILPROC ;file national procedures
  1.  I '$D(^EC(725,"D",CODE)) D
  1.  .S ECDINUM=ECDINUM+1,DINUM=ECDINUM,DIC(0)="L",DLAYGO=725,DIC="^EC(725,"
  1.  .S DIC("DR")="1////^S X=CODE;4///^S X=CPT"
  1.  .D FILE^DICN
  1.  .I +Y>0 D
  1.  ..S COUNT=COUNT+1
  1.  ..D MES^XPDUTL(" ")
  1.  ..S STR="   Entry #"_+Y_" for "_$P(Y,U,2)
  1.  ..S STR=STR_$S(CPT'="":" [CPT: "_CPT_"]",1:"")_" ("_CODE_")"
  1.  ..D BMES^XPDUTL(STR_"  ...successfully added.")
  1.  .I Y=-1 D
  1.  ..D MES^XPDUTL(" ")
  1.  ..D BMES^XPDUTL("ERROR when attempting to add "_NAME_" ("_CODE_")")
  1.  I $D(^EC(725,"DL",CODE)) D
  1.  .S LIEN=$O(^EC(725,"DL",CODE,""))
  1.  .D MES^XPDUTL(" ")
  1.  .D BMES^XPDUTL("   Your site has a local procedure (entry #"_LIEN_") in File #725")
  1.  .D BMES^XPDUTL("   which uses "_CODE_" as its National Number.")
  1.  .D BMES^XPDUTL("   Please inactivate this local procedure.")
  1.  .K Y
  1.  Q
  1. NEW ;national procedures to add;;descript^nation #^CPT code^beg seq^end seq
  1.  ;;VISUAL REINFORCE AUDIO^SP559^92579
  1.  ;;CONDITIONING PLAY AUDIO^SP560^92582
  1.  ;;SELECT PICTURE AUDIO^SP561^92583
  1.  ;;DIAG ANALYSIS CL <7Y^SP562^92601
  1.  ;;SUBS REPROGRAMMING <7Y^SP563^92602
  1.  ;;QUIT