EC725P ;BIR/CML,JPW-Post Updates in Files 725 and 723 ;28 Aug 96
;;2.0; EVENT CAPTURE ;**2,4,5,10**;8 May 96
;
;
EN ;- Entry point for post-init
;
D CRESPEC^EC725P()
Q
;
;
CRESPEC(LABEL) ;patch 5 - add new records to file #723
;
;- Added LABEL parameter for patch EC*2*10 so code can be reused in future
N DIC,X,Y,J,ERR,MSG,CNT,BAD,SAVEY,GOOD
S CNT=0,BAD=1
S LABEL=$G(LABEL)
S MSG="Adding entries to Medical Specialty file (#723)......"
D BMES^XPDUTL(MSG)
;
;- If LABEL not defined, use MEDSPEC line tag as default
S:(LABEL="") LABEL="MEDSPEC"
;
;check for existing exact match; don't add if there already
F J=1:1 S X=$P($T(@LABEL+J),";;",2) Q:X="END" D
. K Y
. S DIC="^ECC(723,"
. S DIC(0)="X"
. D ^DIC
. S SAVEY=+Y
. I SAVEY>0 D
.. S MSG=">>> You already have a "_X_" record. New entry not created."
.. D BMES^XPDUTL(MSG)
.. S BAD=BAD+1,ERR(BAD)=X
. I SAVEY=-1 D
.. K DD,DO,Y
.. D FILE^DICN
.. I Y=-1 S BAD=BAD+1,ERR(BAD)=X
.. I +Y>0 S CNT=CNT+1,GOOD(CNT)=$P(Y,"^",2)
;
;- Let the user know what happened
D MES^XPDUTL("")
;
;- Display entries which weren't created
I $D(ERR) D
.S ERR(1)="The following entries could not be created in file #723:"
.D BMES^XPDUTL(.ERR)
;
;- Display entries successfully added
I CNT>0 D
. D MES^XPDUTL("")
. S MSG="Completed...... a total of "_CNT_" entries were added to file #723."
. D BMES^XPDUTL(MSG)
. S MSG="The following entries have been added:"
. D BMES^XPDUTL(MSG)
. D BMES^XPDUTL(.GOOD)
D MES^XPDUTL("")
Q
;
;
MEDSPEC ;- New medical specialties to be added
;;NURSING
;;RADIOLOGY
;;END
;
;
NEW723 ;#.01 fields for new records
;;OUTPATIENT CLINIC
;;C&P REQUESTS
;;VETERAN CENTER
;;DAY TREATMENT CENTER
;;PAIN CLINIC
;;EMPLOYEE HEALTH
;;NUTRITION AND FOOD SERVICE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEC725P 1846 printed Apr 09, 2024@21:00:11 Page 2
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
+2 ;
+3 ;
EN ;- Entry point for post-init
+1 ;
+2 DO CRESPEC^EC725P()
+3 QUIT
+4 ;
+5 ;
CRESPEC(LABEL) ;patch 5 - add new records to file #723
+1 ;
+2 ;- Added LABEL parameter for patch EC*2*10 so code can be reused in future
+3 NEW DIC,X,Y,J,ERR,MSG,CNT,BAD,SAVEY,GOOD
+4 SET CNT=0
SET BAD=1
+5 SET LABEL=$GET(LABEL)
+6 SET MSG="Adding entries to Medical Specialty file (#723)......"
+7 DO BMES^XPDUTL(MSG)
+8 ;
+9 ;- If LABEL not defined, use MEDSPEC line tag as default
+10 if (LABEL="")
SET LABEL="MEDSPEC"
+11 ;
+12 ;check for existing exact match; don't add if there already
+13 FOR J=1:1
SET X=$PIECE($TEXT(@LABEL+J),";;",2)
if X="END"
QUIT
Begin DoDot:1
+14 KILL Y
+15 SET DIC="^ECC(723,"
+16 SET DIC(0)="X"
+17 DO ^DIC
+18 SET SAVEY=+Y
+19 IF SAVEY>0
Begin DoDot:2
+20 SET MSG=">>> You already have a "_X_" record. New entry not created."
+21 DO BMES^XPDUTL(MSG)
+22 SET BAD=BAD+1
SET ERR(BAD)=X
End DoDot:2
+23 IF SAVEY=-1
Begin DoDot:2
+24 KILL DD,DO,Y
+25 DO FILE^DICN
+26 IF Y=-1
SET BAD=BAD+1
SET ERR(BAD)=X
+27 IF +Y>0
SET CNT=CNT+1
SET GOOD(CNT)=$PIECE(Y,"^",2)
End DoDot:2
End DoDot:1
+28 ;
+29 ;- Let the user know what happened
+30 DO MES^XPDUTL("")
+31 ;
+32 ;- Display entries which weren't created
+33 IF $DATA(ERR)
Begin DoDot:1
+34 SET ERR(1)="The following entries could not be created in file #723:"
+35 DO BMES^XPDUTL(.ERR)
End DoDot:1
+36 ;
+37 ;- Display entries successfully added
+38 IF CNT>0
Begin DoDot:1
+39 DO MES^XPDUTL("")
+40 SET MSG="Completed...... a total of "_CNT_" entries were added to file #723."
+41 DO BMES^XPDUTL(MSG)
+42 SET MSG="The following entries have been added:"
+43 DO BMES^XPDUTL(MSG)
+44 DO BMES^XPDUTL(.GOOD)
End DoDot:1
+45 DO MES^XPDUTL("")
+46 QUIT
+47 ;
+48 ;
MEDSPEC ;- New medical specialties to be added
+1 ;;NURSING
+2 ;;RADIOLOGY
+3 ;;END
+4 ;
+5 ;
NEW723 ;#.01 fields for new records
+1 ;;OUTPATIENT CLINIC
+2 ;;C&P REQUESTS
+3 ;;VETERAN CENTER
+4 ;;DAY TREATMENT CENTER
+5 ;;PAIN CLINIC
+6 ;;EMPLOYEE HEALTH
+7 ;;NUTRITION AND FOOD SERVICE
