DG884P ;PD-REMOTE/DDA,KCL,FT - DG*5.3*884 INSTALL UTILITIES ;6/18/15 3:34pm
;;5.3;Registration;**884**;Aug 13, 1993;Build 31
;;Per VHA Directive 6402, this routine should not be modified.
;
; XLFDT APIs - #10103
; XPDUTL APIs- #10141
; %ZTLOAD - #10063
; ^DIC(4.2) - #3779
; XMBGRP APIs - #1146
; ^XMB(3.8) - #6202
; ICD globals - #6204
; VASITE APIs - #10112
; XMD APIs - #10070
; XUPROD APIs - #4440
;
;--------------------------------------------------
;Patch DG*5.3*884: Environment, Pre-Install, and
;Post-Install entry points.
;--------------------------------------------------
;
ENV ;Main entry point for Environment check items
;Per KIDS documentation: During the environment check routine,
;use of direct WRITEs must be used for output messages.
;
;KIDS variable to indicate if install should abort
;if SET = 2, then abort entire installation
S XPDABORT=""
;
;check programmer variables
W !!,">>> Check programmer variables..."
D PROGCHK(.XPDABORT)
Q:XPDABORT=2
W "Successful"
;
D ICDCHK ;check if ICD*18*64 installed needed entries.
;If not, send message to customer support group on FORUM.
;Do not abort install.
;
;Make certain Q-PTI.DOMAIN.EXT entry exists in DOMAIN (#4.2) file
W !!,">>> Checking for 'Q-PTI.DOMAIN.EXT entry in DOMAIN (#4.2)..."
N DGQPTI
S DGQPTI=+$O(^DIC(4.2,"B","Q-PTI.DOMAIN.EXT",0))
I 'DGQPTI D
.W !,"There is no 'Q-PTI.DOMAIN.EXT' entry in the DOMAIN (#4.2) file."
.W !,"Please see patch XM*999*179 to create this entry and start"
.W !,"this installation again.",!
.S XPDABORT=2
Q:XPDABORT=2
W "Successful"
;success
I XPDABORT="" K XPDABORT
Q
ICDCHK ;Check entry count in some DRG files
N DGCNT,DGI,DGFLAG,DGICD,DGL,DGLOBAL,DGLOOP,DGMSG,DGTEXT
N XMDUZ,XMSUB,XMTEXT,XMY
I $D(XPDENV) D ;use WRITE in ENV check and use MES/BMES^XPDUTL in pre-init
.W !!,">>> Checking number of entries in some DRG files..."
I '$D(XPDENV) D
.S DGTEXT(1)=" "
.S DGTEXT(2)=" "
.S DGTEXT(3)=">>> Checking number of entries in some DRG files..."
.D BMES^XPDUTL(.DGTEXT)
S DGICD(80.5)="DRG SURGICAL HIERARCHY"_U_1_U_"ICDRS"
S DGICD(80.6)="DRG HAC"_U_1_U_"ICDHAC"
S DGICD(82)="DRG DIAGNOSIS HIERARCHY CODES"_U_265_U_"ICDID"
S DGICD(82.1)="DRG PROCEDURE IDENTIFIER CODES"_U_214_U_"ICDIP"
S DGICD(82.11)="DRG PROCEDURE CODE COMBINATIONS"_U_33_U_"ICDIDP"
S DGICD(82.12)="DRG DIAGNOSIS CODE COMBINATIONS"_U_2_U_"ICDIDD"
S DGICD(82.13)="DRG CC EXCLUSIONS"_U_1491_U_"ICDCCEX"
S DGLOOP=0,DGL=2
F S DGLOOP=$O(DGICD(DGLOOP)) Q:'DGLOOP S DGLOBAL=$P(DGICD(DGLOOP),U,3) D:DGLOBAL'="" COUNT
;S DGLOOP=0 F S DGLOOP=$O(DGICD(DGLOOP)) Q:'DGLOOP S $P(DGICD(DGLOOP),U,4)=0 ;for testing only - FT 6/18/15
S (DGFLAG,DGLOOP)=0 ;compare their counts with ours
F S DGLOOP=$O(DGICD(DGLOOP)) Q:'DGLOOP D
.I $P($G(DGICD(DGLOOP)),U,2)'=$P(DGICD(DGLOOP),U,4) D
..I $D(XPDENV) D
...W !,"There is a discrepancy in the number of entries you have"
...W !,"for the "_$P(DGICD(DGLOOP),U,1)_" (#"_DGLOOP_") file."
..I '$D(XPDENV) D
...K DGTEXT
...S DGTEXT(1)="There is a discrepancy in the number of entries you have"
...S DGTEXT(2)="for the "_$P(DGICD(DGLOOP),U,1)_" (#"_DGLOOP_") file."
...D BMES^XPDUTL(.DGTEXT)
..S DGFLAG=1,DGL=DGL+1,DGMSG(DGL)=$P(DGICD(DGLOOP),U,1)_" (#"_DGLOOP_")"
K DGTEXT
I DGFLAG=0 D Q ;file counts are ok, so quit
.W:$D(XPDENV) !," No discrepancies found.",!
.D:'$D(XPDENV) MES^XPDUTL(" No discrepancies found.")
I DGFLAG=1 D ;counts don't match
.W:$D(XPDENV) !," Please log a Remedy ticket.",!
.D:'$D(XPDENV) MES^XPDUTL(" Please log a Remedy ticket.")
Q:$$PROD^XUPROD()=0 ;not a production account. Don't send email.
MAIL ;send MailMan message if file counts don't match
N DIFROM ;per KIDS manual, NEW DIFROM before calling MailMan in env/pre/post routine
S XMDUZ=$S($G(DUZ)>0:DUZ,1:.5)
S XMSUB="DG*5.3*884 - Station "_$P($$SITE^VASITE(),U,3)_" file count issue"
S DGMSG(1)="DG*5.3*884 was installed and found a difference in the number"
S DGMSG(2)="of entries for the following files:"
S XMTEXT="DGMSG("
S XMY("G.CSADMIN1@DOMAIN.EXT")="",XMY("FRANK.TRAXLER@DOMAIN.EXT")=""
D ^XMD
Q
COUNT ;count the number entries in the file, put in 4th piece
S (DGCNT,DGI)=0,DGLOBAL="^"_DGLOBAL
F S DGI=$O(@DGLOBAL@(DGI)) Q:'DGI S DGCNT=DGCNT+1
S $P(DGICD(DGLOOP),U,4)=DGCNT
Q
;
PRE ;Main entry point for Pre-init items
;
;Item 1 - Remove the "AO" cross-references from 5 original OPERATION CODE fields.
D BMES^XPDUTL(">>> Start removal of PTF Operation Code ""AO"" cross-reference...")
;EX. where 45.01=401 sub-file#, 8=OPERATION CODE 1 field#, 1=ien of the XREF in ^DD(45.01,8,1,1,0)="45.01^AO"
D DELIX^DDMOD(45.01,8,1,,"DGAO")
D DELIX^DDMOD(45.01,9,1,,"DGAO")
D DELIX^DDMOD(45.01,10,1,,"DGAO")
D DELIX^DDMOD(45.01,11,1,,"DGAO")
D DELIX^DDMOD(45.01,12,1,,"DGAO")
W !
;
D MES^XPDUTL(" ""AO"" removal completed.")
;
D ICDCHK
;
D NEWMG ;create new PTI mail group
;
PTF125 ;Item 2 - Update PTF125 entry in TRANSMISSION ROUTER (#407.7)
;Make certain Q.PTI.DOMAIN.EXT exists in DOMAIN (#4.2)
;Make certain PTF125 entry exists in TRANSMISSION ROUTERS (#407.7).
;Create PTF125 entry, if necessary.
;In PTF125 entry, set TRANSMIT=NO for Q-PTT.DOMAIN.EXT (old queue)
;In PTF125 entry, set TRANSMIT=YES for Q-PTI.DOMAIN.EXT (new queue)
N DGARRAY,DGFDA,DGERROR,DGFLAG,DGIEN,DGLOOP,DGLOOP1,DGQPTI,DGTEXT
S DGTEXT(1)=">>> Updating PTF125 entry in TRANSMISSION ROUTER (#407.7) file."
S DGTEXT(2)=" Setting TRANSMIT=NO for (existing) receiving user@Q-PTT.DOMAIN.EXT."
S DGTEXT(3)=" Creating new receiving user@Q-PTI.DOMAIN.EXT."
D BMES^XPDUTL(.DGTEXT)
K DGTEXT
S DGQPTI=+$O(^DIC(4.2,"B","Q-PTI.DOMAIN.EXT",0))
I 'DGQPTI D
.S DGTEXT(1)="There is no 'Q-PTI.DOMAIN.EXT' entry in the DOMAIN (#4.2) file."
.S DGTEXT(2)="Please see patch XM*999*179 to create this entry and start"
.S DGTEXT(3)="the installation again."
.D STOP
Q:$G(XPDABORT)=1
S DGIEN=$O(^VAT(407.7,"B","PTF125",0))
I 'DGIEN D CREATE ;create PTF125 entry if it doesn't exist
S DGIEN=$O(^VAT(407.7,"B","PTF125",0))
I 'DGIEN D
.S DGTEXT(1)="There is no 'PTF125' entry in the TRANSMISSION ROUTERS (#407.7) file."
.S DGTEXT(2)="Stopping installation. Log a ticket ASAP."
.D STOP
Q:$G(XPDABORT)=1
D GETS^DIQ(407.7,DGIEN_",","**","EI","DGARRAY","DGERROR")
I $D(DGERROR) D
.S DGTEXT(1)="Cannot retrieve the 'PTF125' values from the TRANSMISSION ROUTERS"
.S DGTEXT(2)="(#407.7) file. Stopping installation. Log a ticket ASAP."
.D STOP
Q:$G(XPDABORT)=1
S DGLOOP=""
S DGLOOP=$O(DGARRAY(407.7,DGLOOP))
I DGLOOP="" D
.S DGTEXT(1)="Cannot find the 'PTF125' entry in the TRANSMISSION ROUTERS"
.S DGTEXT(2)="(#407.7) file. Stopping installation. Log a ticket ASAP."
.D STOP
Q:$G(XPDABORT)=1
I $G(DGARRAY(407.7,DGLOOP,.01,"E"))'="PTF125" D
.S DGTEXT(1)="Cannot find the 'PTF125' entry in the TRANSMISSION ROUTERS"
.S DGTEXT(2)="(#407.7) file. Stopping installation. Log a ticket ASAP."
.D STOP
Q:$G(XPDABORT)=1
S DGLOOP1=""
F S DGLOOP1=$O(DGARRAY(407.71,DGLOOP1)) Q:DGLOOP1="" D
.I $G(DGARRAY(407.71,DGLOOP1,1,"E"))'="Q-PTT.DOMAIN.EXT" Q
.I $G(DGARRAY(407.71,DGLOOP1,2,"E"))="NO" Q
.D TURNOFF ;turn off transmit to Q-PTT
.I $D(DGERROR) D
..S DGTEXT(1)="Could not set TRANSMIT='NO' for Q-PTT.DOMAIN.EXT."
..S DGTEXT(2)="Stopping installation. Log a ticket ASAP."
..D STOP
Q:$G(XPDABORT)=1
S DGLOOP1="",DGFLAG=0
F S DGLOOP1=$O(DGARRAY(407.71,DGLOOP1)) Q:DGLOOP1="" D
.I $G(DGARRAY(407.71,DGLOOP1,1,"E"))'="Q-PTI.DOMAIN.EXT" Q
.I $G(DGARRAY(407.71,DGLOOP1,2,"E"))="YES" S DGFLAG=1 Q
.D TURNON ;turn on transmit to Q-PTI
.I $D(DGERROR) D
..S DGTEXT(1)="Could not set TRANSMIT='YES' for Q-PTI.DOMAIN.EXT."
..S DGTEXT(2)="Stopping installation. Log a ticket ASAP."
..D STOP
Q:$G(XPDABORT)=1
Q:DGFLAG
D NEWRU ;create new RECEIVING USER (multiple)
I $D(DGERROR) D
.S DGTEXT(1)="Could not create a new RECEIVING USER for Q-PTI.DOMAIN.EXT."
.S DGTEXT(2)="Stopping installation. Log a ticket ASAP."
.D STOP
Q:$G(XPDABORT)=1
Q
TURNOFF ;set TRANSMIT field (FILE 407.71, Field 2) to NO
;for Q-PTT.DOMAIN.EXT (old transmission queue)
K DGFDA,DGERROR
S DGFDA(407.71,DGLOOP1,2)=0
D UPDATE^DIE("","DGFDA",,"DGERROR")
Q
TURNON ;set TRANSMIT field (FILE 407.71, Field 2) to YES
;for Q-PTI.DOMAIN.EXT (new transmission queue
K DGFDA,DGERROR
S DGFDA(407.71,DGLOOP1,2)=1
D UPDATE^DIE("","DGFDA",,"DGERROR")
S DGFLAG=1
Q
NEWRU ;Create new RECEIVING USER
K DGFDA,DGERROR
S DGFDA(407.71,"+1,"_DGIEN_",",.01)="XXX" ;generic user
S DGFDA(407.71,"+1,"_DGIEN_",",1)=DGQPTI ;ien of Q-PTI.DOMAIN.EXT
S DGFDA(407.71,"+1,"_DGIEN_",",2)=1 ;1=YES
D UPDATE^DIE("","DGFDA",,"DGERROR")
Q
CREATE ;create a PTF125 entry in FILE 407.7
K DGFDA,DGERROR
S DGFDA(407.7,"+1,",.01)="PTF125"
S DGFDA(407.7,"+1,",.02)=100
S DGFDA(407.7,"+1,",.03)=50
D UPDATE^DIE("","DGFDA",,"DGERROR")
Q
STOP ;display message and set XPDABORT=1 (stop patch install)
D BMES^XPDUTL(.DGTEXT)
S XPDABORT=1
Q
;
NEWMG ;Create new 'PTI' mail group in FILE #3.8. Add PTT members to PTI.
; Input: None
; Output: None
;
N DGIEN ;ien of record in Mail Group (#3.8) file
N DGGNM ;name of mail group
N DGTXT ;array of text to put in description field of mail group
N DGXMY ;array of local users to add to the mail group
N DGFLAG ;indicator if any PTT members exist
S DGGNM="PTI",DGFLAG="Y"
;
D BMES^XPDUTL(">>> Creating new 'PTI' mail group...")
;
;short circuit if mail group already exists
I $$FIND1^DIC(3.8,"","X",DGGNM,"B") D Q
. D MES^XPDUTL(" WARNING: Mail Group "_DGGNM_" already exists.")
. D MES^XPDUTL(" Since the mail group exists, no action is required.")
;
;create new mail group and add installer as a member if no PTT members
D MEMBER
I '$O(DGXMY(0)) S DGXMY($G(DUZ))="",DGFLAG="N" ;want at least one member
S DGTXT(1)="This mail group will receive confirmation mail messages from the"
S DGTXT(2)="Austin Information Technology Center (AITC) postmaster for PTF"
S DGTXT(3)="transaction messages sent to the Domain Q-PTI.DOMAIN.EXT."
S DGTXT(4)="This mail group supports the interface between PTF and the"
S DGTXT(5)="AITC."
;
I $$MG^XMBGRP(DGGNM,0,$G(DUZ),0,.DGXMY,.DGTXT,1) D
. D MES^XPDUTL(" Mail Group "_DGGNM_" was successfully created.")
. D MES^XPDUTL(" This mail group will receive confirmation mail messages")
. D MES^XPDUTL(" from the Austin Information Technology Center (AITC)")
. D MES^XPDUTL(" postmaster for PTF transaction messages sent to the")
. D MES^XPDUTL(" Domain Q-PTI.DOMAIN.EXT.")
. D MES^XPDUTL("")
. D:DGFLAG="N" MES^XPDUTL(" You have been added as the sole member of this mail group.")
. D:DGFLAG="N" MES^XPDUTL(" Please enter other members as appropriate.")
. D:DGFLAG="Y" MES^XPDUTL(" PTT mail group members have been added to this mail group.")
E D
. D MES^XPDUTL(" ERROR: Mail Group was not created!")
. D MES^XPDUTL(" Please enter a support ticket for assistance.")
Q
MEMBER ;find MAIL GROUP (3.8) MEMBERs and set DGXMY array
N DGARRAY,DGDUZ,DGERROR,DGLOOP,DGMG
S DGMG=$O(^XMB(3.8,"B","PTT",0))
Q:'DGMG
D GETS^DIQ(3.8,DGMG_",","**","EI","DGARRAY","DGERROR")
Q:'$D(DGARRAY(3.81)) ;no MEMBERs
S DGLOOP=""
F S DGLOOP=$O(DGARRAY(3.81,DGLOOP)) Q:DGLOOP="" D
.S DGDUZ=$G(DGARRAY(3.81,DGLOOP,.01,"I"))
.S:DGDUZ>0 DGXMY(DGDUZ)=""
Q
;
POST ;Main entry point for Post-init items
;
;Item 1 - Rebuild PTF portion of the Clinical Reminders Global Index ^PXRMINDX(45).
D REINDEX
;
;Item 2 - Re-compile input templates
D RECOMP
;
Q
;
PROGCHK(XPDABORT) ;
;Check for required programmer variables
;This procedure will determine if the installers programmer variables are set up.
;Per KIDS documentation: During the environment check routine, use of direct
;WRITEs must be used for output messages.
;
; Input:
; XPDABORT - KIDS var to indicate if install should
; abort, passed by reference
;
; Output:
; XPDABORT - if = 2, then abort entire installation
;
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
. W !!," **********"
. W !," ERROR: Environment check failed!"
. W !," Your programming variables are not set up properly. Once"
. W !," your programming variables are set up correctly, re-install"
. W !," this patch DG*5.3*884."
. W !," **********"
. ;tell KIDS to abort the entire installation of the distribution
. S XPDABORT=2
Q
;
REINDEX ;Rebuild the PTF portion of the Clinical Reminders Global Index
N DGINSTDT,DGRSLT,DGTEXT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
;
D BMES^XPDUTL(">>> Rebuild PTF portion of the Clinical Reminders Global Index...")
;
;if patch 884 has already been installed and index rebuilt, skip another rebuild
I $$INSTALDT^XPDUTL("DG*5.3*884",.DGRSLT) D
. S DGINSTDT=+$O(DGRSLT(0)) ;get first install date
. ;if index was built after first install then skip rebuild
. I $G(^PXRMINDX(45,"DATE BUILT"))>DGINSTDT D
. . S DGTEXT(1)=" The DG*5.3*884 patch has previously been installed."
. . S DGTEXT(2)=" Skipping another rebuild of the PTF portion of the index."
;quit if a rebuild is not needed
I $D(DGTEXT(1)) D BMES^XPDUTL(.DGTEXT) Q
;
;queue off PTF Clinical Reminders Global Index rebuild
S ZTRTN="INDEX^DGPTDDCR"
S ZTDESC="DG*5.3*884 PTF Clinical Reminders Global Index rebuild"
S ZTDTH=$$NOW^XLFDT
S ZTIO=""
D ^%ZTLOAD
S DGTEXT(1)=" PTF Clinical Reminders Global Index rebuild queued."
S DGTEXT(2)=" The task number is "_$G(ZTSK)_"."
D MES^XPDUTL(.DGTEXT)
Q
;
RECOMP ;Recompile input templates
;Recompile all compiled input templates that contain specific fields.
;This is needed because the data dictionary definition of these fields
;has changed and they are being exported via KIDS.
;
; Supported ICR #3352: This ICR provides the use of DIEZ^DIKCUTL3 to recompile
; all compiled input templates that contain specific fields.
;
N DGFLD
;
D BMES^XPDUTL(">>> Re-compiling input templates...")
;
;build array of file and field numbers for top-level (#45) file fields being exported
;array format: DGFLD(file#,field)=""
F DGFLD=79,79.16,79.17,79.18,79.19,79.201,79.21,79.22,79.23,79.24,79.241,79.242,79.243,79.244 S DGFLD(45,DGFLD)=""
F DGFLD=79.245,79.246,79.247,79.248,79.249,79.2491,79.24911,79.24912,79.24913,79.24914,79.24915 S DGFLD(45,DGFLD)=""
F DGFLD=82.01,82.02,82.03,82.04,82.05,82.06,82.07,82.08,82.09,82.1,82.11,82.12,82.13 S DGFLD(45,DGFLD)=""
F DGFLD=82.14,82.15,82.16,82.17,82.18,82.19,82.2,82.21,82.22,82.23,82.24,82.25 S DGFLD(45,DGFLD)=""
;
;build array of file and field numbers for 401 (#45.01) sub-file fields being exported
;array format: DGFLD(sub-file#,field)=""
F DGFLD=8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32 S DGFLD(45.01,DGFLD)=""
;
;build array of file and field numbers for 501 (#45.02) sub-file fields being exported
;array format: DGFLD(sub-file#,field)=""
F DGFLD=5,6,7,8,9,11,12,13,14,15,81.01,81.02,81.03,81.04,81.05,81.06,81.07,81.08,81.09 S DGFLD(45.02,DGFLD)=""
F DGFLD=81.1,81.11,81.12,81.13,81.14,81.15,82.01,82.02,82.03,82.04,82.05,82.06,82.07,82.08,82.09,82.1 S DGFLD(45.02,DGFLD)=""
F DGFLD=82.11,82.12,82.13,82.14,82.15,82.16,82.17,82.18,82.19,82.2,82.21,82.22,82.23,82.24,82.25 S DGFLD(45.02,DGFLD)=""
;
;build array of file and field numbers for 601 (#45.05) sub-file fields being exported
;array format: DGFLD(sub-file#,field)=""
F DGFLD=4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28 S DGFLD(45.05,DGFLD)=""
;
;recompile all compiled input templates that contain the fields in the DGLFD array passed by reference
D DIEZ^DIKCUTL3(45,.DGFLD)
K DGFLD
;
D BMES^XPDUTL(" Re-compile completed.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG884P 16033 printed Apr 09, 2024@22:04:59 Page 2
DG884P ;PD-REMOTE/DDA,KCL,FT - DG*5.3*884 INSTALL UTILITIES ;6/18/15 3:34pm
+1 ;;5.3;Registration;**884**;Aug 13, 1993;Build 31
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 ; XLFDT APIs - #10103
+5 ; XPDUTL APIs- #10141
+6 ; %ZTLOAD - #10063
+7 ; ^DIC(4.2) - #3779
+8 ; XMBGRP APIs - #1146
+9 ; ^XMB(3.8) - #6202
+10 ; ICD globals - #6204
+11 ; VASITE APIs - #10112
+12 ; XMD APIs - #10070
+13 ; XUPROD APIs - #4440
+14 ;
+15 ;--------------------------------------------------
+16 ;Patch DG*5.3*884: Environment, Pre-Install, and
+17 ;Post-Install entry points.
+18 ;--------------------------------------------------
+19 ;
ENV ;Main entry point for Environment check items
+1 ;Per KIDS documentation: During the environment check routine,
+2 ;use of direct WRITEs must be used for output messages.
+3 ;
+4 ;KIDS variable to indicate if install should abort
+5 ;if SET = 2, then abort entire installation
+6 SET XPDABORT=""
+7 ;
+8 ;check programmer variables
+9 WRITE !!,">>> Check programmer variables..."
+10 DO PROGCHK(.XPDABORT)
+11 if XPDABORT=2
QUIT
+12 WRITE "Successful"
+13 ;
+14 ;check if ICD*18*64 installed needed entries.
DO ICDCHK
+15 ;If not, send message to customer support group on FORUM.
+16 ;Do not abort install.
+17 ;
+18 ;Make certain Q-PTI.DOMAIN.EXT entry exists in DOMAIN (#4.2) file
+19 WRITE !!,">>> Checking for 'Q-PTI.DOMAIN.EXT entry in DOMAIN (#4.2)..."
+20 NEW DGQPTI
+21 SET DGQPTI=+$ORDER(^DIC(4.2,"B","Q-PTI.DOMAIN.EXT",0))
+22 IF 'DGQPTI
Begin DoDot:1
+23 WRITE !,"There is no 'Q-PTI.DOMAIN.EXT' entry in the DOMAIN (#4.2) file."
+24 WRITE !,"Please see patch XM*999*179 to create this entry and start"
+25 WRITE !,"this installation again.",!
+26 SET XPDABORT=2
End DoDot:1
+27 if XPDABORT=2
QUIT
+28 WRITE "Successful"
+29 ;success
+30 IF XPDABORT=""
KILL XPDABORT
+31 QUIT
ICDCHK ;Check entry count in some DRG files
+1 NEW DGCNT,DGI,DGFLAG,DGICD,DGL,DGLOBAL,DGLOOP,DGMSG,DGTEXT
+2 NEW XMDUZ,XMSUB,XMTEXT,XMY
+3 ;use WRITE in ENV check and use MES/BMES^XPDUTL in pre-init
IF $DATA(XPDENV)
Begin DoDot:1
+4 WRITE !!,">>> Checking number of entries in some DRG files..."
End DoDot:1
+5 IF '$DATA(XPDENV)
Begin DoDot:1
+6 SET DGTEXT(1)=" "
+7 SET DGTEXT(2)=" "
+8 SET DGTEXT(3)=">>> Checking number of entries in some DRG files..."
+9 DO BMES^XPDUTL(.DGTEXT)
End DoDot:1
+10 SET DGICD(80.5)="DRG SURGICAL HIERARCHY"_U_1_U_"ICDRS"
+11 SET DGICD(80.6)="DRG HAC"_U_1_U_"ICDHAC"
+12 SET DGICD(82)="DRG DIAGNOSIS HIERARCHY CODES"_U_265_U_"ICDID"
+13 SET DGICD(82.1)="DRG PROCEDURE IDENTIFIER CODES"_U_214_U_"ICDIP"
+14 SET DGICD(82.11)="DRG PROCEDURE CODE COMBINATIONS"_U_33_U_"ICDIDP"
+15 SET DGICD(82.12)="DRG DIAGNOSIS CODE COMBINATIONS"_U_2_U_"ICDIDD"
+16 SET DGICD(82.13)="DRG CC EXCLUSIONS"_U_1491_U_"ICDCCEX"
+17 SET DGLOOP=0
SET DGL=2
+18 FOR
SET DGLOOP=$ORDER(DGICD(DGLOOP))
if 'DGLOOP
QUIT
SET DGLOBAL=$PIECE(DGICD(DGLOOP),U,3)
if DGLOBAL'=""
DO COUNT
+19 ;S DGLOOP=0 F S DGLOOP=$O(DGICD(DGLOOP)) Q:'DGLOOP S $P(DGICD(DGLOOP),U,4)=0 ;for testing only - FT 6/18/15
+20 ;compare their counts with ours
SET (DGFLAG,DGLOOP)=0
+21 FOR
SET DGLOOP=$ORDER(DGICD(DGLOOP))
if 'DGLOOP
QUIT
Begin DoDot:1
+22 IF $PIECE($GET(DGICD(DGLOOP)),U,2)'=$PIECE(DGICD(DGLOOP),U,4)
Begin DoDot:2
+23 IF $DATA(XPDENV)
Begin DoDot:3
+24 WRITE !,"There is a discrepancy in the number of entries you have"
+25 WRITE !,"for the "_$PIECE(DGICD(DGLOOP),U,1)_" (#"_DGLOOP_") file."
End DoDot:3
+26 IF '$DATA(XPDENV)
Begin DoDot:3
+27 KILL DGTEXT
+28 SET DGTEXT(1)="There is a discrepancy in the number of entries you have"
+29 SET DGTEXT(2)="for the "_$PIECE(DGICD(DGLOOP),U,1)_" (#"_DGLOOP_") file."
+30 DO BMES^XPDUTL(.DGTEXT)
End DoDot:3
+31 SET DGFLAG=1
SET DGL=DGL+1
SET DGMSG(DGL)=$PIECE(DGICD(DGLOOP),U,1)_" (#"_DGLOOP_")"
End DoDot:2
End DoDot:1
+32 KILL DGTEXT
+33 ;file counts are ok, so quit
IF DGFLAG=0
Begin DoDot:1
+34 if $DATA(XPDENV)
WRITE !," No discrepancies found.",!
+35 if '$DATA(XPDENV)
DO MES^XPDUTL(" No discrepancies found.")
End DoDot:1
QUIT
+36 ;counts don't match
IF DGFLAG=1
Begin DoDot:1
+37 if $DATA(XPDENV)
WRITE !," Please log a Remedy ticket.",!
+38 if '$DATA(XPDENV)
DO MES^XPDUTL(" Please log a Remedy ticket.")
End DoDot:1
+39 ;not a production account. Don't send email.
if $$PROD^XUPROD()=0
QUIT
MAIL ;send MailMan message if file counts don't match
+1 ;per KIDS manual, NEW DIFROM before calling MailMan in env/pre/post routine
NEW DIFROM
+2 SET XMDUZ=$SELECT($GET(DUZ)>0:DUZ,1:.5)
+3 SET XMSUB="DG*5.3*884 - Station "_$PIECE($$SITE^VASITE(),U,3)_" file count issue"
+4 SET DGMSG(1)="DG*5.3*884 was installed and found a difference in the number"
+5 SET DGMSG(2)="of entries for the following files:"
+6 SET XMTEXT="DGMSG("
+7 SET XMY("G.CSADMIN1@DOMAIN.EXT")=""
SET XMY("FRANK.TRAXLER@DOMAIN.EXT")=""
+8 DO ^XMD
+9 QUIT
COUNT ;count the number entries in the file, put in 4th piece
+1 SET (DGCNT,DGI)=0
SET DGLOBAL="^"_DGLOBAL
+2 FOR
SET DGI=$ORDER(@DGLOBAL@(DGI))
if 'DGI
QUIT
SET DGCNT=DGCNT+1
+3 SET $PIECE(DGICD(DGLOOP),U,4)=DGCNT
+4 QUIT
+5 ;
PRE ;Main entry point for Pre-init items
+1 ;
+2 ;Item 1 - Remove the "AO" cross-references from 5 original OPERATION CODE fields.
+3 DO BMES^XPDUTL(">>> Start removal of PTF Operation Code ""AO"" cross-reference...")
+4 ;EX. where 45.01=401 sub-file#, 8=OPERATION CODE 1 field#, 1=ien of the XREF in ^DD(45.01,8,1,1,0)="45.01^AO"
+5 DO DELIX^DDMOD(45.01,8,1,,"DGAO")
+6 DO DELIX^DDMOD(45.01,9,1,,"DGAO")
+7 DO DELIX^DDMOD(45.01,10,1,,"DGAO")
+8 DO DELIX^DDMOD(45.01,11,1,,"DGAO")
+9 DO DELIX^DDMOD(45.01,12,1,,"DGAO")
+10 WRITE !
+11 ;
+12 DO MES^XPDUTL(" ""AO"" removal completed.")
+13 ;
+14 DO ICDCHK
+15 ;
+16 ;create new PTI mail group
DO NEWMG
+17 ;
PTF125 ;Item 2 - Update PTF125 entry in TRANSMISSION ROUTER (#407.7)
+1 ;Make certain Q.PTI.DOMAIN.EXT exists in DOMAIN (#4.2)
+2 ;Make certain PTF125 entry exists in TRANSMISSION ROUTERS (#407.7).
+3 ;Create PTF125 entry, if necessary.
+4 ;In PTF125 entry, set TRANSMIT=NO for Q-PTT.DOMAIN.EXT (old queue)
+5 ;In PTF125 entry, set TRANSMIT=YES for Q-PTI.DOMAIN.EXT (new queue)
+6 NEW DGARRAY,DGFDA,DGERROR,DGFLAG,DGIEN,DGLOOP,DGLOOP1,DGQPTI,DGTEXT
+7 SET DGTEXT(1)=">>> Updating PTF125 entry in TRANSMISSION ROUTER (#407.7) file."
+8 SET DGTEXT(2)=" Setting TRANSMIT=NO for (existing) receiving user@Q-PTT.DOMAIN.EXT."
+9 SET DGTEXT(3)=" Creating new receiving user@Q-PTI.DOMAIN.EXT."
+10 DO BMES^XPDUTL(.DGTEXT)
+11 KILL DGTEXT
+12 SET DGQPTI=+$ORDER(^DIC(4.2,"B","Q-PTI.DOMAIN.EXT",0))
+13 IF 'DGQPTI
Begin DoDot:1
+14 SET DGTEXT(1)="There is no 'Q-PTI.DOMAIN.EXT' entry in the DOMAIN (#4.2) file."
+15 SET DGTEXT(2)="Please see patch XM*999*179 to create this entry and start"
+16 SET DGTEXT(3)="the installation again."
+17 DO STOP
End DoDot:1
+18 if $GET(XPDABORT)=1
QUIT
+19 SET DGIEN=$ORDER(^VAT(407.7,"B","PTF125",0))
+20 ;create PTF125 entry if it doesn't exist
IF 'DGIEN
DO CREATE
+21 SET DGIEN=$ORDER(^VAT(407.7,"B","PTF125",0))
+22 IF 'DGIEN
Begin DoDot:1
+23 SET DGTEXT(1)="There is no 'PTF125' entry in the TRANSMISSION ROUTERS (#407.7) file."
+24 SET DGTEXT(2)="Stopping installation. Log a ticket ASAP."
+25 DO STOP
End DoDot:1
+26 if $GET(XPDABORT)=1
QUIT
+27 DO GETS^DIQ(407.7,DGIEN_",","**","EI","DGARRAY","DGERROR")
+28 IF $DATA(DGERROR)
Begin DoDot:1
+29 SET DGTEXT(1)="Cannot retrieve the 'PTF125' values from the TRANSMISSION ROUTERS"
+30 SET DGTEXT(2)="(#407.7) file. Stopping installation. Log a ticket ASAP."
+31 DO STOP
End DoDot:1
+32 if $GET(XPDABORT)=1
QUIT
+33 SET DGLOOP=""
+34 SET DGLOOP=$ORDER(DGARRAY(407.7,DGLOOP))
+35 IF DGLOOP=""
Begin DoDot:1
+36 SET DGTEXT(1)="Cannot find the 'PTF125' entry in the TRANSMISSION ROUTERS"
+37 SET DGTEXT(2)="(#407.7) file. Stopping installation. Log a ticket ASAP."
+38 DO STOP
End DoDot:1
+39 if $GET(XPDABORT)=1
QUIT
+40 IF $GET(DGARRAY(407.7,DGLOOP,.01,"E"))'="PTF125"
Begin DoDot:1
+41 SET DGTEXT(1)="Cannot find the 'PTF125' entry in the TRANSMISSION ROUTERS"
+42 SET DGTEXT(2)="(#407.7) file. Stopping installation. Log a ticket ASAP."
+43 DO STOP
End DoDot:1
+44 if $GET(XPDABORT)=1
QUIT
+45 SET DGLOOP1=""
+46 FOR
SET DGLOOP1=$ORDER(DGARRAY(407.71,DGLOOP1))
if DGLOOP1=""
QUIT
Begin DoDot:1
+47 IF $GET(DGARRAY(407.71,DGLOOP1,1,"E"))'="Q-PTT.DOMAIN.EXT"
QUIT
+48 IF $GET(DGARRAY(407.71,DGLOOP1,2,"E"))="NO"
QUIT
+49 ;turn off transmit to Q-PTT
DO TURNOFF
+50 IF $DATA(DGERROR)
Begin DoDot:2
+51 SET DGTEXT(1)="Could not set TRANSMIT='NO' for Q-PTT.DOMAIN.EXT."
+52 SET DGTEXT(2)="Stopping installation. Log a ticket ASAP."
+53 DO STOP
End DoDot:2
End DoDot:1
+54 if $GET(XPDABORT)=1
QUIT
+55 SET DGLOOP1=""
SET DGFLAG=0
+56 FOR
SET DGLOOP1=$ORDER(DGARRAY(407.71,DGLOOP1))
if DGLOOP1=""
QUIT
Begin DoDot:1
+57 IF $GET(DGARRAY(407.71,DGLOOP1,1,"E"))'="Q-PTI.DOMAIN.EXT"
QUIT
+58 IF $GET(DGARRAY(407.71,DGLOOP1,2,"E"))="YES"
SET DGFLAG=1
QUIT
+59 ;turn on transmit to Q-PTI
DO TURNON
+60 IF $DATA(DGERROR)
Begin DoDot:2
+61 SET DGTEXT(1)="Could not set TRANSMIT='YES' for Q-PTI.DOMAIN.EXT."
+62 SET DGTEXT(2)="Stopping installation. Log a ticket ASAP."
+63 DO STOP
End DoDot:2
End DoDot:1
+64 if $GET(XPDABORT)=1
QUIT
+65 if DGFLAG
QUIT
+66 ;create new RECEIVING USER (multiple)
DO NEWRU
+67 IF $DATA(DGERROR)
Begin DoDot:1
+68 SET DGTEXT(1)="Could not create a new RECEIVING USER for Q-PTI.DOMAIN.EXT."
+69 SET DGTEXT(2)="Stopping installation. Log a ticket ASAP."
+70 DO STOP
End DoDot:1
+71 if $GET(XPDABORT)=1
QUIT
+72 QUIT
TURNOFF ;set TRANSMIT field (FILE 407.71, Field 2) to NO
+1 ;for Q-PTT.DOMAIN.EXT (old transmission queue)
+2 KILL DGFDA,DGERROR
+3 SET DGFDA(407.71,DGLOOP1,2)=0
+4 DO UPDATE^DIE("","DGFDA",,"DGERROR")
+5 QUIT
TURNON ;set TRANSMIT field (FILE 407.71, Field 2) to YES
+1 ;for Q-PTI.DOMAIN.EXT (new transmission queue
+2 KILL DGFDA,DGERROR
+3 SET DGFDA(407.71,DGLOOP1,2)=1
+4 DO UPDATE^DIE("","DGFDA",,"DGERROR")
+5 SET DGFLAG=1
+6 QUIT
NEWRU ;Create new RECEIVING USER
+1 KILL DGFDA,DGERROR
+2 ;generic user
SET DGFDA(407.71,"+1,"_DGIEN_",",.01)="XXX"
+3 ;ien of Q-PTI.DOMAIN.EXT
SET DGFDA(407.71,"+1,"_DGIEN_",",1)=DGQPTI
+4 ;1=YES
SET DGFDA(407.71,"+1,"_DGIEN_",",2)=1
+5 DO UPDATE^DIE("","DGFDA",,"DGERROR")
+6 QUIT
CREATE ;create a PTF125 entry in FILE 407.7
+1 KILL DGFDA,DGERROR
+2 SET DGFDA(407.7,"+1,",.01)="PTF125"
+3 SET DGFDA(407.7,"+1,",.02)=100
+4 SET DGFDA(407.7,"+1,",.03)=50
+5 DO UPDATE^DIE("","DGFDA",,"DGERROR")
+6 QUIT
STOP ;display message and set XPDABORT=1 (stop patch install)
+1 DO BMES^XPDUTL(.DGTEXT)
+2 SET XPDABORT=1
+3 QUIT
+4 ;
NEWMG ;Create new 'PTI' mail group in FILE #3.8. Add PTT members to PTI.
+1 ; Input: None
+2 ; Output: None
+3 ;
+4 ;ien of record in Mail Group (#3.8) file
NEW DGIEN
+5 ;name of mail group
NEW DGGNM
+6 ;array of text to put in description field of mail group
NEW DGTXT
+7 ;array of local users to add to the mail group
NEW DGXMY
+8 ;indicator if any PTT members exist
NEW DGFLAG
+9 SET DGGNM="PTI"
SET DGFLAG="Y"
+10 ;
+11 DO BMES^XPDUTL(">>> Creating new 'PTI' mail group...")
+12 ;
+13 ;short circuit if mail group already exists
+14 IF $$FIND1^DIC(3.8,"","X",DGGNM,"B")
Begin DoDot:1
+15 DO MES^XPDUTL(" WARNING: Mail Group "_DGGNM_" already exists.")
+16 DO MES^XPDUTL(" Since the mail group exists, no action is required.")
End DoDot:1
QUIT
+17 ;
+18 ;create new mail group and add installer as a member if no PTT members
+19 DO MEMBER
+20 ;want at least one member
IF '$ORDER(DGXMY(0))
SET DGXMY($GET(DUZ))=""
SET DGFLAG="N"
+21 SET DGTXT(1)="This mail group will receive confirmation mail messages from the"
+22 SET DGTXT(2)="Austin Information Technology Center (AITC) postmaster for PTF"
+23 SET DGTXT(3)="transaction messages sent to the Domain Q-PTI.DOMAIN.EXT."
+24 SET DGTXT(4)="This mail group supports the interface between PTF and the"
+25 SET DGTXT(5)="AITC."
+26 ;
+27 IF $$MG^XMBGRP(DGGNM,0,$GET(DUZ),0,.DGXMY,.DGTXT,1)
Begin DoDot:1
+28 DO MES^XPDUTL(" Mail Group "_DGGNM_" was successfully created.")
+29 DO MES^XPDUTL(" This mail group will receive confirmation mail messages")
+30 DO MES^XPDUTL(" from the Austin Information Technology Center (AITC)")
+31 DO MES^XPDUTL(" postmaster for PTF transaction messages sent to the")
+32 DO MES^XPDUTL(" Domain Q-PTI.DOMAIN.EXT.")
+33 DO MES^XPDUTL("")
+34 if DGFLAG="N"
DO MES^XPDUTL(" You have been added as the sole member of this mail group.")
+35 if DGFLAG="N"
DO MES^XPDUTL(" Please enter other members as appropriate.")
+36 if DGFLAG="Y"
DO MES^XPDUTL(" PTT mail group members have been added to this mail group.")
End DoDot:1
+37 IF '$TEST
Begin DoDot:1
+38 DO MES^XPDUTL(" ERROR: Mail Group was not created!")
+39 DO MES^XPDUTL(" Please enter a support ticket for assistance.")
End DoDot:1
+40 QUIT
MEMBER ;find MAIL GROUP (3.8) MEMBERs and set DGXMY array
+1 NEW DGARRAY,DGDUZ,DGERROR,DGLOOP,DGMG
+2 SET DGMG=$ORDER(^XMB(3.8,"B","PTT",0))
+3 if 'DGMG
QUIT
+4 DO GETS^DIQ(3.8,DGMG_",","**","EI","DGARRAY","DGERROR")
+5 ;no MEMBERs
if '$DATA(DGARRAY(3.81))
QUIT
+6 SET DGLOOP=""
+7 FOR
SET DGLOOP=$ORDER(DGARRAY(3.81,DGLOOP))
if DGLOOP=""
QUIT
Begin DoDot:1
+8 SET DGDUZ=$GET(DGARRAY(3.81,DGLOOP,.01,"I"))
+9 if DGDUZ>0
SET DGXMY(DGDUZ)=""
End DoDot:1
+10 QUIT
+11 ;
POST ;Main entry point for Post-init items
+1 ;
+2 ;Item 1 - Rebuild PTF portion of the Clinical Reminders Global Index ^PXRMINDX(45).
+3 DO REINDEX
+4 ;
+5 ;Item 2 - Re-compile input templates
+6 DO RECOMP
+7 ;
+8 QUIT
+9 ;
PROGCHK(XPDABORT) ;
+1 ;Check for required programmer variables
+2 ;This procedure will determine if the installers programmer variables are set up.
+3 ;Per KIDS documentation: During the environment check routine, use of direct
+4 ;WRITEs must be used for output messages.
+5 ;
+6 ; Input:
+7 ; XPDABORT - KIDS var to indicate if install should
+8 ; abort, passed by reference
+9 ;
+10 ; Output:
+11 ; XPDABORT - if = 2, then abort entire installation
+12 ;
+13 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+14 WRITE !!," **********"
+15 WRITE !," ERROR: Environment check failed!"
+16 WRITE !," Your programming variables are not set up properly. Once"
+17 WRITE !," your programming variables are set up correctly, re-install"
+18 WRITE !," this patch DG*5.3*884."
+19 WRITE !," **********"
+20 ;tell KIDS to abort the entire installation of the distribution
+21 SET XPDABORT=2
End DoDot:1
+22 QUIT
+23 ;
REINDEX ;Rebuild the PTF portion of the Clinical Reminders Global Index
+1 NEW DGINSTDT,DGRSLT,DGTEXT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
+2 ;
+3 DO BMES^XPDUTL(">>> Rebuild PTF portion of the Clinical Reminders Global Index...")
+4 ;
+5 ;if patch 884 has already been installed and index rebuilt, skip another rebuild
+6 IF $$INSTALDT^XPDUTL("DG*5.3*884",.DGRSLT)
Begin DoDot:1
+7 ;get first install date
SET DGINSTDT=+$ORDER(DGRSLT(0))
+8 ;if index was built after first install then skip rebuild
+9 IF $GET(^PXRMINDX(45,"DATE BUILT"))>DGINSTDT
Begin DoDot:2
+10 SET DGTEXT(1)=" The DG*5.3*884 patch has previously been installed."
+11 SET DGTEXT(2)=" Skipping another rebuild of the PTF portion of the index."
End DoDot:2
End DoDot:1
+12 ;quit if a rebuild is not needed
+13 IF $DATA(DGTEXT(1))
DO BMES^XPDUTL(.DGTEXT)
QUIT
+14 ;
+15 ;queue off PTF Clinical Reminders Global Index rebuild
+16 SET ZTRTN="INDEX^DGPTDDCR"
+17 SET ZTDESC="DG*5.3*884 PTF Clinical Reminders Global Index rebuild"
+18 SET ZTDTH=$$NOW^XLFDT
+19 SET ZTIO=""
+20 DO ^%ZTLOAD
+21 SET DGTEXT(1)=" PTF Clinical Reminders Global Index rebuild queued."
+22 SET DGTEXT(2)=" The task number is "_$GET(ZTSK)_"."
+23 DO MES^XPDUTL(.DGTEXT)
+24 QUIT
+25 ;
RECOMP ;Recompile input templates
+1 ;Recompile all compiled input templates that contain specific fields.
+2 ;This is needed because the data dictionary definition of these fields
+3 ;has changed and they are being exported via KIDS.
+4 ;
+5 ; Supported ICR #3352: This ICR provides the use of DIEZ^DIKCUTL3 to recompile
+6 ; all compiled input templates that contain specific fields.
+7 ;
+8 NEW DGFLD
+9 ;
+10 DO BMES^XPDUTL(">>> Re-compiling input templates...")
+11 ;
+12 ;build array of file and field numbers for top-level (#45) file fields being exported
+13 ;array format: DGFLD(file#,field)=""
+14 FOR DGFLD=79,79.16,79.17,79.18,79.19,79.201,79.21,79.22,79.23,79.24,79.241,79.242,79.243,79.244
SET DGFLD(45,DGFLD)=""
+15 FOR DGFLD=79.245,79.246,79.247,79.248,79.249,79.2491,79.24911,79.24912,79.24913,79.24914,79.24915
SET DGFLD(45,DGFLD)=""
+16 FOR DGFLD=82.01,82.02,82.03,82.04,82.05,82.06,82.07,82.08,82.09,82.1,82.11,82.12,82.13
SET DGFLD(45,DGFLD)=""
+17 FOR DGFLD=82.14,82.15,82.16,82.17,82.18,82.19,82.2,82.21,82.22,82.23,82.24,82.25
SET DGFLD(45,DGFLD)=""
+18 ;
+19 ;build array of file and field numbers for 401 (#45.01) sub-file fields being exported
+20 ;array format: DGFLD(sub-file#,field)=""
+21 FOR DGFLD=8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32
SET DGFLD(45.01,DGFLD)=""
+22 ;
+23 ;build array of file and field numbers for 501 (#45.02) sub-file fields being exported
+24 ;array format: DGFLD(sub-file#,field)=""
+25 FOR DGFLD=5,6,7,8,9,11,12,13,14,15,81.01,81.02,81.03,81.04,81.05,81.06,81.07,81.08,81.09
SET DGFLD(45.02,DGFLD)=""
+26 FOR DGFLD=81.1,81.11,81.12,81.13,81.14,81.15,82.01,82.02,82.03,82.04,82.05,82.06,82.07,82.08,82.09,82.1
SET DGFLD(45.02,DGFLD)=""
+27 FOR DGFLD=82.11,82.12,82.13,82.14,82.15,82.16,82.17,82.18,82.19,82.2,82.21,82.22,82.23,82.24,82.25
SET DGFLD(45.02,DGFLD)=""
+28 ;
+29 ;build array of file and field numbers for 601 (#45.05) sub-file fields being exported
+30 ;array format: DGFLD(sub-file#,field)=""
+31 FOR DGFLD=4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28
SET DGFLD(45.05,DGFLD)=""
+32 ;
+33 ;recompile all compiled input templates that contain the fields in the DGLFD array passed by reference
+34 DO DIEZ^DIKCUTL3(45,.DGFLD)
+35 KILL DGFLD
+36 ;
+37 DO BMES^XPDUTL(" Re-compile completed.")
+38 QUIT
