ECX338PT.m

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 ---ECX338PT   1251     printed  Apr 09, 2024@20:59:06                                                                                                                                                                                                    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