ECX338PT ;ALB/JAM,TMD - PATCH ECX*3.0*38 Post-Init Rtn ; 8/6/01 12:31pm
;;3.0;DSS EXTRACTS;**38**;Jun 07, 2000
;
;post-init routine to add new entry to DSS LAB TESTS file (#727.2)
;
D ADD7272
Q
ADD7272 ;add entries to file #727.2
;ECXX is in format: ien;test^source
N ECX,ECXX,DA,DIC,DINUM,DIE,DR,X,Y,TEST,SOURCE,CNT
D MES^XPDUTL(" ")
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(" Adding "_TEST_" as entry #"_ECXDA_"... ok.")
..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
;;50;HEMATOCRIT^B
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX338PT 1251 printed Dec 13, 2024@01:49:56 Page 2
ECX338PT ;ALB/JAM,TMD - PATCH ECX*3.0*38 Post-Init Rtn ; 8/6/01 12:31pm
+1 ;;3.0;DSS EXTRACTS;**38**;Jun 07, 2000
+2 ;
+3 ;post-init routine to add new entry to DSS LAB TESTS file (#727.2)
+4 ;
+5 DO ADD7272
+6 QUIT
ADD7272 ;add entries to file #727.2
+1 ;ECXX is in format: ien;test^source
+2 NEW ECX,ECXX,DA,DIC,DINUM,DIE,DR,X,Y,TEST,SOURCE,CNT
+3 DO MES^XPDUTL(" ")
+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(" Adding "_TEST_" as entry #"_ECXDA_"... ok.")
+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 ;;50;HEMATOCRIT^B
+2 ;;QUIT
