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

EC725P.m

Go to the documentation of this file.
  1. EC725P ;BIR/CML,JPW-Post Updates in Files 725 and 723 ;28 Aug 96
  1. ;;2.0; EVENT CAPTURE ;**2,4,5,10**;8 May 96
  1. ;
  1. ;
  1. EN ;- Entry point for post-init
  1. ;
  1. D CRESPEC^EC725P()
  1. Q
  1. ;
  1. ;
  1. CRESPEC(LABEL) ;patch 5 - add new records to file #723
  1. ;
  1. ;- Added LABEL parameter for patch EC*2*10 so code can be reused in future
  1. N DIC,X,Y,J,ERR,MSG,CNT,BAD,SAVEY,GOOD
  1. S CNT=0,BAD=1
  1. S LABEL=$G(LABEL)
  1. S MSG="Adding entries to Medical Specialty file (#723)......"
  1. D BMES^XPDUTL(MSG)
  1. ;
  1. ;- If LABEL not defined, use MEDSPEC line tag as default
  1. S:(LABEL="") LABEL="MEDSPEC"
  1. ;
  1. ;check for existing exact match; don't add if there already
  1. F J=1:1 S X=$P($T(@LABEL+J),";;",2) Q:X="END" D
  1. . K Y
  1. . S DIC="^ECC(723,"
  1. . S DIC(0)="X"
  1. . D ^DIC
  1. . S SAVEY=+Y
  1. . I SAVEY>0 D
  1. .. S MSG=">>> You already have a "_X_" record. New entry not created."
  1. .. D BMES^XPDUTL(MSG)
  1. .. S BAD=BAD+1,ERR(BAD)=X
  1. . I SAVEY=-1 D
  1. .. K DD,DO,Y
  1. .. D FILE^DICN
  1. .. I Y=-1 S BAD=BAD+1,ERR(BAD)=X
  1. .. I +Y>0 S CNT=CNT+1,GOOD(CNT)=$P(Y,"^",2)
  1. ;
  1. ;- Let the user know what happened
  1. D MES^XPDUTL("")
  1. ;
  1. ;- Display entries which weren't created
  1. I $D(ERR) D
  1. .S ERR(1)="The following entries could not be created in file #723:"
  1. .D BMES^XPDUTL(.ERR)
  1. ;
  1. ;- Display entries successfully added
  1. I CNT>0 D
  1. . D MES^XPDUTL("")
  1. . S MSG="Completed...... a total of "_CNT_" entries were added to file #723."
  1. . D BMES^XPDUTL(MSG)
  1. . S MSG="The following entries have been added:"
  1. . D BMES^XPDUTL(MSG)
  1. . D BMES^XPDUTL(.GOOD)
  1. D MES^XPDUTL("")
  1. Q
  1. ;
  1. ;
  1. MEDSPEC ;- New medical specialties to be added
  1. ;;NURSING
  1. ;;RADIOLOGY
  1. ;;END
  1. ;
  1. ;
  1. NEW723 ;#.01 fields for new records
  1. ;;OUTPATIENT CLINIC
  1. ;;C&P REQUESTS
  1. ;;VETERAN CENTER
  1. ;;DAY TREATMENT CENTER
  1. ;;PAIN CLINIC
  1. ;;EMPLOYEE HEALTH
  1. ;;NUTRITION AND FOOD SERVICE