ECX351PT ;ALB/ESD - PATCH ECX*3.0*51 Post-Init Rtn ; 6/30/03
;;3.0;DSS EXTRACTS;**51**;Dec 22, 1997
;
;Post-init routine to add new entries to:
; DSS LAB TESTS file (#727.2)
; NATIONAL CLINIC file (#728.441)
;
;
EN D ADD7272
D OBF
Q
OBF ;Update OCCULT BLOOD (FECAL) to have a Source of Feces
N ECXX,ECXDA,TEST,SOURCE
D MES^XPDUTL(" ")
D BMES^XPDUTL(">>> Updating OCCULT BLOOD (FECAL)...")
D MES^XPDUTL(" ")
S ECXX="55;OCCULT BLOOD (FECAL)^F",ECXDA=$P(ECXX,";",1)
S ECXX=$P(ECXX,";",2)
Q:'$D(^ECX(727.2,1,1,ECXDA,0))
S TEST=$P(ECXX,"^"),SOURCE=$P(ECXX,"^",2)
S $P(^ECX(727.2,1,1,ECXDA,0),"^",2)=SOURCE
K ^ECX(727.2,"S","B",1,ECXDA)
S ^ECX(727.2,"S","F",1,ECXDA)=""
D MES^XPDUTL(">>>...."_TEST_" updated with Source "_SOURCE_".")
Q
;
;
ADD7272 ;- Add new entries to file #727.2
; ECXX is in format: ien;test^source
;
N ECX,ECXDA,ECXX,DA,DIC,DINUM,DIE,DR,X,Y,TEST,SOURCE,CNT
D MES^XPDUTL(" ")
D MES^XPDUTL(">>> Adding entries to DSS LAB TESTS File (#727.2)...")
D MES^XPDUTL(" ")
S $P(^DD(727.21,.01,0),U,5)="",CNT=0
F ECX=1:1 S ECXX=$P($T(NEW7272+ECX),";;",2) Q:ECXX="QUIT" D
.S ECXDA=$P(ECXX,";",1),ECXX=$P(ECXX,";",2)
.Q:'$D(^ECX(727.2,1))
.I $D(^ECX(727.2,1,1,0)),'$D(^ECX(727.2,1,1,ECXDA,0)) D
..S CNT=CNT+1
..S TEST=$P(ECXX,U,1),SOURCE=$P(ECXX,U,2)
..S DA(1)=1,DIC("P")=$P(^DD(727.2,1,0),U,2),DINUM=ECXDA
..S X=TEST,DIC="^ECX(727.2,1,1,",DLAYGO=727.21,DIC(0)="LX",DIC("DR")="2///^S X=SOURCE"
..K DD,DO D FILE^DICN K DLAYGO
..D MES^XPDUTL(" ")
..D MES^XPDUTL(">>>...."_TEST_" added to file as entry #"_ECXDA_".")
..D MES^XPDUTL(" ")
I CNT=0 D
.D MES^XPDUTL(">>>....Entries already exist -- nothing added.")
.D MES^XPDUTL(" ")
S $P(^DD(727.21,.01,0),U,5)="K X"
Q
;
NEW7272 ;- New records for file #727.2
;;57;GLUCOSE POC (FINGER STICK)^B
;;58;TROPONIN T^B
;;59;TROPONIN I^B
;;QUIT
;
;
POST1 ;- Add new entry to file 728.441
; ECXREC is in format: code^short description
;
;
N ECXFDA,ECXERR,ECXCODE,ECXREC,I
D BMES^XPDUTL(">>> Adding entry to the NATIONAL CLINIC (#728.441) file...")
;
;- Get NATIONAL CLINIC record
F I=1:1 S ECXREC=$P($T(NATCLIN+I),";;",2) Q:ECXREC="QUIT" D
.;
.;- National Clinic code
.S ECXCODE=$P(ECXREC,"^")
.;
.;- Quit w/error message if entry already exists in file #728.441
.I $$FIND1^DIC(728.441,"","X",ECXCODE) D Q
..D BMES^XPDUTL(">>>...."_ECXCODE_" "_$P(ECXREC,U,2)_" not added, entry already exists.")
..D BMES^XPDUTL(">>> Delete entries and reinstall patch if entries were not created by a")
..D MES^XPDUTL(">>> previous installation of this patch.")
.;
.;- Setup field values of new entry
.S ECXFDA(728.441,"+1,",.01)=ECXCODE
.S ECXFDA(728.441,"+1,",1)=$P(ECXREC,"^",2)
.;
.;- Add new entry to file #728.441
.D UPDATE^DIE("E","ECXFDA","","ECXERR")
.;
.I '$D(ECXERR) D BMES^XPDUTL(">>>...."_ECXCODE_" "_$P(ECXREC,U,2)_" added to file.")
.I $D(ECXERR) D BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" "_$P(ECXREC,U,2)_" to file.")
;
Q
;
NATCLIN ;- Contains the NATIONAL CLINIC entry to be added
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX351PT 3150 printed Dec 13, 2024@01:50 Page 2
ECX351PT ;ALB/ESD - PATCH ECX*3.0*51 Post-Init Rtn ; 6/30/03
+1 ;;3.0;DSS EXTRACTS;**51**;Dec 22, 1997
+2 ;
+3 ;Post-init routine to add new entries to:
+4 ; DSS LAB TESTS file (#727.2)
+5 ; NATIONAL CLINIC file (#728.441)
+6 ;
+7 ;
EN DO ADD7272
+1 DO OBF
+2 QUIT
OBF ;Update OCCULT BLOOD (FECAL) to have a Source of Feces
+1 NEW ECXX,ECXDA,TEST,SOURCE
+2 DO MES^XPDUTL(" ")
+3 DO BMES^XPDUTL(">>> Updating OCCULT BLOOD (FECAL)...")
+4 DO MES^XPDUTL(" ")
+5 SET ECXX="55;OCCULT BLOOD (FECAL)^F"
SET ECXDA=$PIECE(ECXX,";",1)
+6 SET ECXX=$PIECE(ECXX,";",2)
+7 if '$DATA(^ECX(727.2,1,1,ECXDA,0))
QUIT
+8 SET TEST=$PIECE(ECXX,"^")
SET SOURCE=$PIECE(ECXX,"^",2)
+9 SET $PIECE(^ECX(727.2,1,1,ECXDA,0),"^",2)=SOURCE
+10 KILL ^ECX(727.2,"S","B",1,ECXDA)
+11 SET ^ECX(727.2,"S","F",1,ECXDA)=""
+12 DO MES^XPDUTL(">>>...."_TEST_" updated with Source "_SOURCE_".")
+13 QUIT
+14 ;
+15 ;
ADD7272 ;- Add new entries to file #727.2
+1 ; ECXX is in format: ien;test^source
+2 ;
+3 NEW ECX,ECXDA,ECXX,DA,DIC,DINUM,DIE,DR,X,Y,TEST,SOURCE,CNT
+4 DO MES^XPDUTL(" ")
+5 DO MES^XPDUTL(">>> Adding entries to DSS LAB TESTS File (#727.2)...")
+6 DO MES^XPDUTL(" ")
+7 SET $PIECE(^DD(727.21,.01,0),U,5)=""
SET CNT=0
+8 FOR ECX=1:1
SET ECXX=$PIECE($TEXT(NEW7272+ECX),";;",2)
if ECXX="QUIT"
QUIT
Begin DoDot:1
+9 SET ECXDA=$PIECE(ECXX,";",1)
SET ECXX=$PIECE(ECXX,";",2)
+10 if '$DATA(^ECX(727.2,1))
QUIT
+11 IF $DATA(^ECX(727.2,1,1,0))
IF '$DATA(^ECX(727.2,1,1,ECXDA,0))
Begin DoDot:2
+12 SET CNT=CNT+1
+13 SET TEST=$PIECE(ECXX,U,1)
SET SOURCE=$PIECE(ECXX,U,2)
+14 SET DA(1)=1
SET DIC("P")=$PIECE(^DD(727.2,1,0),U,2)
SET DINUM=ECXDA
+15 SET X=TEST
SET DIC="^ECX(727.2,1,1,"
SET DLAYGO=727.21
SET DIC(0)="LX"
SET DIC("DR")="2///^S X=SOURCE"
+16 KILL DD,DO
DO FILE^DICN
KILL DLAYGO
+17 DO MES^XPDUTL(" ")
+18 DO MES^XPDUTL(">>>...."_TEST_" added to file as entry #"_ECXDA_".")
+19 DO MES^XPDUTL(" ")
End DoDot:2
End DoDot:1
+20 IF CNT=0
Begin DoDot:1
+21 DO MES^XPDUTL(">>>....Entries already exist -- nothing added.")
+22 DO MES^XPDUTL(" ")
End DoDot:1
+23 SET $PIECE(^DD(727.21,.01,0),U,5)="K X"
+24 QUIT
+25 ;
NEW7272 ;- New records for file #727.2
+1 ;;57;GLUCOSE POC (FINGER STICK)^B
+2 ;;58;TROPONIN T^B
+3 ;;59;TROPONIN I^B
+4 ;;QUIT
+5 ;
+6 ;
POST1 ;- Add new entry to file 728.441
+1 ; ECXREC is in format: code^short description
+2 ;
+3 ;
+4 NEW ECXFDA,ECXERR,ECXCODE,ECXREC,I
+5 DO BMES^XPDUTL(">>> Adding entry to the NATIONAL CLINIC (#728.441) file...")
+6 ;
+7 ;- Get NATIONAL CLINIC record
+8 FOR I=1:1
SET ECXREC=$PIECE($TEXT(NATCLIN+I),";;",2)
if ECXREC="QUIT"
QUIT
Begin DoDot:1
+9 ;
+10 ;- National Clinic code
+11 SET ECXCODE=$PIECE(ECXREC,"^")
+12 ;
+13 ;- Quit w/error message if entry already exists in file #728.441
+14 IF $$FIND1^DIC(728.441,"","X",ECXCODE)
Begin DoDot:2
+15 DO BMES^XPDUTL(">>>...."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" not added, entry already exists.")
+16 DO BMES^XPDUTL(">>> Delete entries and reinstall patch if entries were not created by a")
+17 DO MES^XPDUTL(">>> previous installation of this patch.")
End DoDot:2
QUIT
+18 ;
+19 ;- Setup field values of new entry
+20 SET ECXFDA(728.441,"+1,",.01)=ECXCODE
+21 SET ECXFDA(728.441,"+1,",1)=$PIECE(ECXREC,"^",2)
+22 ;
+23 ;- Add new entry to file #728.441
+24 DO UPDATE^DIE("E","ECXFDA","","ECXERR")
+25 ;
+26 IF '$DATA(ECXERR)
DO BMES^XPDUTL(">>>...."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" added to file.")
+27 IF $DATA(ECXERR)
DO BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" "_$PIECE(ECXREC,U,2)_" to file.")
End DoDot:1
+28 ;
+29 QUIT
+30 ;
NATCLIN ;- Contains the NATIONAL CLINIC entry to be added
+1 ;;QUIT
