DG53653A.m

DG53653A ;ALB/TDM,CKN - Patch DG*5.3*653 Post-Install Utility Routine ; 10/24/06 11:39am

 ;;5.3;Registration;**653**;AUG 13, 1993;Build 2

 Q

 ;

EN N DIE,DA,DR

 D MOD386          ;Edit file 38.6 entries

 D EP^DG53653U     ;Add file 38.6 entries

 D DELXREF         ;Remove cross references

 D HECMSG          ;Send Message to HEC Legacy

 Q

 ;

MOD386 ; Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)

 N ERR

 F RULE=4,7,9,11,13,15,16,19,24,29,30,31,34,60,72,74,75,76,78,81,83,85,86 D

 . D BMES^XPDUTL("Modifying entry #"_RULE_" in 38.6 file.")

 . S DIE=38.6,DA=$$FIND1^DIC(DIE,"","X",RULE)

 . I 'DA D MES^XPDUTL("    *** Entry not found! ***") Q

 . S DR="6////1" D ^DIE

 . D MES^XPDUTL("    *** Update Complete ***")

 D BMES^XPDUTL("")

 Q

 ;

DELXREF ;Delete x-ref and indexes

 N ZINDX

 D BMES^XPDUTL(">>> Deleting ADELBAI index from PATIENT File #2")

 D DELIXN^DDMOD(2,"ADELBAI")

 Q

HECMSG ; Send message to HEC Legacy that install is complete.

 N SITE,STATN,PRODFLG,XMDUZ,XMSUB,XMY,XMTEXT,MSG

 S SITE=$$SITE^VASITE,STATN=$P($G(SITE),U,3)

 S PRODFLG=$$GET1^DIQ(869.3,"1,",.03,"I")="P"

 S XMDUZ="EVC I1 Install"

 S XMSUB=XMDUZ_" - "_STATN_" (DG*5.3*653)"

 S:PRODFLG XMY("S.IVMB*2*860 MESSAGE@IVM.DOMAIN.EXT")=""

 S:'PRODFLG XMY(DUZ)=""

 S XMTEXT="MSG("

 S $P(MSG(1),U)="IVMB*2*860"

 S $P(MSG(1),U,2)=STATN

 S $P(MSG(1),U,3)="DG*5.3*653 "_$$FMTE^XLFDT($$NOW^XLFDT(),"5D")

 S $P(MSG(1),U,4)=PRODFLG

 D ^XMD

 D BMES^XPDUTL("    *** Install Message Sent to HEC Legacy ***")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53653A   1520     printed  Apr 23, 2025@18:52:03                                                                                                                                                                                                    Page 2

DG53653A  ;ALB/TDM,CKN - Patch DG*5.3*653 Post-Install Utility Routine ; 10/24/06 11:39am

 +1       ;;5.3;Registration;**653**;AUG 13, 1993;Build 2

 +2        QUIT 

 +3       ;

EN         NEW DIE,DA,DR

 +1       ;Edit file 38.6 entries

           DO MOD386

 +2       ;Add file 38.6 entries

           DO EP^DG53653U

 +3       ;Remove cross references

           DO DELXREF

 +4       ;Send Message to HEC Legacy

           DO HECMSG

 +5        QUIT 

 +6       ;

MOD386    ; Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)

 +1        NEW ERR

 +2        FOR RULE=4,7,9,11,13,15,16,19,24,29,30,31,34,60,72,74,75,76,78,81,83,85,86

               Begin DoDot:1

 +3                DO BMES^XPDUTL("Modifying entry #"_RULE_" in 38.6 file.")

 +4                SET DIE=38.6

                   SET DA=$$FIND1^DIC(DIE,"","X",RULE)

 +5                IF 'DA

                       DO MES^XPDUTL("    *** Entry not found! ***")

                       QUIT 

 +6                SET DR="6////1"

                   DO ^DIE

 +7                DO MES^XPDUTL("    *** Update Complete ***")

               End DoDot:1

 +8        DO BMES^XPDUTL("")

 +9        QUIT 

 +10      ;

DELXREF   ;Delete x-ref and indexes

 +1        NEW ZINDX

 +2        DO BMES^XPDUTL(">>> Deleting ADELBAI index from PATIENT File #2")

 +3        DO DELIXN^DDMOD(2,"ADELBAI")

 +4        QUIT 

HECMSG    ; Send message to HEC Legacy that install is complete.

 +1        NEW SITE,STATN,PRODFLG,XMDUZ,XMSUB,XMY,XMTEXT,MSG

 +2        SET SITE=$$SITE^VASITE

           SET STATN=$PIECE($GET(SITE),U,3)

 +3        SET PRODFLG=$$GET1^DIQ(869.3,"1,",.03,"I")="P"

 +4        SET XMDUZ="EVC I1 Install"

 +5        SET XMSUB=XMDUZ_" - "_STATN_" (DG*5.3*653)"

 +6        if PRODFLG

               SET XMY("S.IVMB*2*860 MESSAGE@IVM.DOMAIN.EXT")=""

 +7        if 'PRODFLG

               SET XMY(DUZ)=""

 +8        SET XMTEXT="MSG("

 +9        SET $PIECE(MSG(1),U)="IVMB*2*860"

 +10       SET $PIECE(MSG(1),U,2)=STATN

 +11       SET $PIECE(MSG(1),U,3)="DG*5.3*653 "_$$FMTE^XLFDT($$NOW^XLFDT(),"5D")

 +12       SET $PIECE(MSG(1),U,4)=PRODFLG

 +13       DO ^XMD

 +14       DO BMES^XPDUTL("    *** Install Message Sent to HEC Legacy ***")

 +15       QUIT