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

ECX351PT.m

Go to the documentation of this file. 
  1. ECX351PT ;ALB/ESD - PATCH ECX*3.0*51 Post-Init Rtn ; 6/30/03
  1.  ;;3.0;DSS EXTRACTS;**51**;Dec 22, 1997
  1.  ;
  1.  ;Post-init routine to add new entries to:
  1.  ;           DSS LAB TESTS file   (#727.2)
  1.  ;           NATIONAL CLINIC file (#728.441)
  1.  ;
  1.  ;
  1. EN D ADD7272
  1.  D OBF
  1.  Q
  1. OBF ;Update OCCULT BLOOD (FECAL) to have a Source of Feces
  1.  N ECXX,ECXDA,TEST,SOURCE
  1.  D MES^XPDUTL(" ")
  1.  D BMES^XPDUTL(">>> Updating OCCULT BLOOD (FECAL)...")
  1.  D MES^XPDUTL(" ")
  1.  S ECXX="55;OCCULT BLOOD (FECAL)^F",ECXDA=$P(ECXX,";",1)
  1.  S ECXX=$P(ECXX,";",2)
  1.  Q:'$D(^ECX(727.2,1,1,ECXDA,0))
  1.  S TEST=$P(ECXX,"^"),SOURCE=$P(ECXX,"^",2)
  1.  S $P(^ECX(727.2,1,1,ECXDA,0),"^",2)=SOURCE
  1.  K ^ECX(727.2,"S","B",1,ECXDA)
  1.  S ^ECX(727.2,"S","F",1,ECXDA)=""
  1.  D MES^XPDUTL(">>>...."_TEST_" updated with Source "_SOURCE_".")
  1.  Q
  1.  ;
  1.  ;
  1. ADD7272 ;- Add new entries to file #727.2
  1.  ;      ECXX is in format: ien;test^source
  1.  ;
  1.  N ECX,ECXDA,ECXX,DA,DIC,DINUM,DIE,DR,X,Y,TEST,SOURCE,CNT
  1.  D MES^XPDUTL(" ")
  1.  D MES^XPDUTL(">>> Adding entries to DSS LAB TESTS File (#727.2)...")
  1.  D MES^XPDUTL(" ")
  1.  S $P(^DD(727.21,.01,0),U,5)="",CNT=0
  1.  F ECX=1:1 S ECXX=$P($T(NEW7272+ECX),";;",2) Q:ECXX="QUIT"  D
  1.  .S ECXDA=$P(ECXX,";",1),ECXX=$P(ECXX,";",2)
  1.  .Q:'$D(^ECX(727.2,1))
  1.  .I $D(^ECX(727.2,1,1,0)),'$D(^ECX(727.2,1,1,ECXDA,0)) D
  1.  ..S CNT=CNT+1
  1.  ..S TEST=$P(ECXX,U,1),SOURCE=$P(ECXX,U,2)
  1.  ..S DA(1)=1,DIC("P")=$P(^DD(727.2,1,0),U,2),DINUM=ECXDA
  1.  ..S X=TEST,DIC="^ECX(727.2,1,1,",DLAYGO=727.21,DIC(0)="LX",DIC("DR")="2///^S X=SOURCE"
  1.  ..K DD,DO D FILE^DICN K DLAYGO
  1.  ..D MES^XPDUTL(" ")
  1.  ..D MES^XPDUTL(">>>...."_TEST_" added to file as entry #"_ECXDA_".")
  1.  ..D MES^XPDUTL(" ")
  1.  I CNT=0 D
  1.  .D MES^XPDUTL(">>>....Entries already exist -- nothing added.")
  1.  .D MES^XPDUTL(" ")
  1.  S $P(^DD(727.21,.01,0),U,5)="K X"
  1.  Q
  1.  ;
  1. NEW7272 ;- New records for file #727.2
  1.  ;;57;GLUCOSE POC (FINGER STICK)^B
  1.  ;;58;TROPONIN T^B
  1.  ;;59;TROPONIN I^B
  1.  ;;QUIT
  1.  ;
  1.  ;
  1. POST1 ;- Add new entry to file 728.441
  1.  ;      ECXREC is in format: code^short description
  1.  ;
  1.  ;
  1.  N ECXFDA,ECXERR,ECXCODE,ECXREC,I
  1.  D BMES^XPDUTL(">>> Adding entry to the NATIONAL CLINIC (#728.441) file...")
  1.  ;
  1.  ;- Get NATIONAL CLINIC record
  1.  F I=1:1 S ECXREC=$P($T(NATCLIN+I),";;",2) Q:ECXREC="QUIT"  D
  1.  .;
  1.  .;- National Clinic code
  1.  .S ECXCODE=$P(ECXREC,"^")
  1.  .;
  1.  .;- Quit w/error message if entry already exists in file #728.441
  1.  .I $$FIND1^DIC(728.441,"","X",ECXCODE) D  Q
  1.  ..D BMES^XPDUTL(">>>...."_ECXCODE_"  "_$P(ECXREC,U,2)_"  not added, entry already exists.")
  1.  ..D BMES^XPDUTL(">>> Delete entries and reinstall patch if entries were not created by a")
  1.  ..D MES^XPDUTL(">>> previous installation of this patch.")
  1.  .;
  1.  .;- Setup field values of new entry
  1.  .S ECXFDA(728.441,"+1,",.01)=ECXCODE
  1.  .S ECXFDA(728.441,"+1,",1)=$P(ECXREC,"^",2)
  1.  .;
  1.  .;- Add new entry to file #728.441
  1.  .D UPDATE^DIE("E","ECXFDA","","ECXERR")
  1.  .;
  1.  .I '$D(ECXERR) D BMES^XPDUTL(">>>...."_ECXCODE_"  "_$P(ECXREC,U,2)_"  added to file.")
  1.  .I $D(ECXERR) D BMES^XPDUTL(">>>....Unable to add "_ECXCODE_"  "_$P(ECXREC,U,2)_" to file.")
  1.  ;
  1.  Q
  1.  ;
  1. NATCLIN ;- Contains the NATIONAL CLINIC entry to be added
  1.  ;;QUIT