| 1 | DG53653A ;ALB/TDM,CKN - Patch DG*5.3*653 Post-Install Utility Routine ; 10/24/06 11:39am
|
|---|
| 2 | ;;5.3;Registration;**653**;AUG 13, 1993;Build 2
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | EN N DIE,DA,DR
|
|---|
| 6 | D MOD386 ;Edit file 38.6 entries
|
|---|
| 7 | D EP^DG53653U ;Add file 38.6 entries
|
|---|
| 8 | D DELXREF ;Remove cross references
|
|---|
| 9 | D HECMSG ;Send Message to HEC Legacy
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | MOD386 ; Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)
|
|---|
| 13 | N ERR
|
|---|
| 14 | 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
|
|---|
| 15 | . D BMES^XPDUTL("Modifying entry #"_RULE_" in 38.6 file.")
|
|---|
| 16 | . S DIE=38.6,DA=$$FIND1^DIC(DIE,"","X",RULE)
|
|---|
| 17 | . I 'DA D MES^XPDUTL(" *** Entry not found! ***") Q
|
|---|
| 18 | . S DR="6////1" D ^DIE
|
|---|
| 19 | . D MES^XPDUTL(" *** Update Complete ***")
|
|---|
| 20 | D BMES^XPDUTL("")
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | DELXREF ;Delete x-ref and indexes
|
|---|
| 24 | N ZINDX
|
|---|
| 25 | D BMES^XPDUTL(">>> Deleting ADELBAI index from PATIENT File #2")
|
|---|
| 26 | D DELIXN^DDMOD(2,"ADELBAI")
|
|---|
| 27 | Q
|
|---|
| 28 | HECMSG ; Send message to HEC Legacy that install is complete.
|
|---|
| 29 | N SITE,STATN,PRODFLG,XMDUZ,XMSUB,XMY,XMTEXT,MSG
|
|---|
| 30 | S SITE=$$SITE^VASITE,STATN=$P($G(SITE),U,3)
|
|---|
| 31 | S PRODFLG=$$GET1^DIQ(869.3,"1,",.03,"I")="P"
|
|---|
| 32 | S XMDUZ="EVC I1 Install"
|
|---|
| 33 | S XMSUB=XMDUZ_" - "_STATN_" (DG*5.3*653)"
|
|---|
| 34 | S:PRODFLG XMY("S.IVMB*2*860 MESSAGE@IVM.MED.VA.GOV")=""
|
|---|
| 35 | S:'PRODFLG XMY(DUZ)=""
|
|---|
| 36 | S XMTEXT="MSG("
|
|---|
| 37 | S $P(MSG(1),U)="IVMB*2*860"
|
|---|
| 38 | S $P(MSG(1),U,2)=STATN
|
|---|
| 39 | S $P(MSG(1),U,3)="DG*5.3*653 "_$$FMTE^XLFDT($$NOW^XLFDT(),"5D")
|
|---|
| 40 | S $P(MSG(1),U,4)=PRODFLG
|
|---|
| 41 | D ^XMD
|
|---|
| 42 | D BMES^XPDUTL(" *** Install Message Sent to HEC Legacy ***")
|
|---|
| 43 | Q
|
|---|
