DG648PST ;BIR/CMC-PATCH DG*5.3*648 POST INSTALLATION ROUTINE ;2/11/05
;;5.3;Registration;**648**;Aug 13, 1993
;
POST ;Post init
N DGFLD,DGMFLD,DGOUT,DGFILE
;File cross references
D XR(2,.525) ;POW STATUS INDICATED?
;;D XR(2.0361,.01) ;PATIENT ELIGIBILITIES MULTIPLE ELIGIBILITY FIELD -- MOVED TO DG*5.3*691
D TEMPL
;fix missing leading zeros for ICN Checksums DD issue was corrected in MPIF*1.0*9
D MES^XPDUTL(" >>> Checking ICN Checksums for missing leading zeros. Job being tasked off.")
S ZTRTN="CHKSUM^DG648PST",ZTDESC="Correct missing leading zeros in ICN Checksum - DG*5.3*648"
S ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
I $D(DUZ) S ZTSAVE("DUZ")=DUZ
D ^%ZTLOAD
K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,%
Q
;
CHKSUM ;fix missing leading zeros for ICN Checksums
K ^XTMP("DG648","MISSING CHECKSUM"),^XTMP("DG648","CHECKSUM UPDATE"),^XTMP("DG648","CHECKSUM UPDATE FAIL")
N DFN,ICN,CHECK,DIE,DA,DR,X,Y,CNT,CNT2,CNT3,LEN
S (CNT2,CNT3,CNT,ICN)=0
F S ICN=$O(^DPT("AICN",ICN)) Q:ICN="" D
.Q:$E(ICN,1,3)=$P($$SITE^VASITE,"^",3)
.S DFN=$O(^DPT("AICN",ICN,""))
.I ICN'=$P($G(^DPT(DFN,"MPI")),"^") Q
.; ^ ONLY UPDATING PRIMARY ICN
.S CHECK=$P($G(^DPT(DFN,"MPI")),"^",2)
.I CHECK="" S CNT2=CNT2+1,^XTMP("DG648","MISSING CHECKSUM",CNT2)="DFN= "_DFN_"^"_"ICN= "_ICN Q
.S LEN=$L(CHECK)
.Q:LEN=6
.I LEN<6 S CHECK=$E(1000000+CHECK,2,7) ;adding missing leading zeros
.K X,Y,DIE,DA,DR
.S DA=DFN
.D LOCK(DA) ;LOCK DPT NODE "MPI"
.S DIE="^DPT(",DR="991.02///^S X=CHECK" D ^DIE
.L -^DPT(DA,"MPI")
.I +$G(Y)=-1 S CNT3=CNT3+1,^XTMP("DG648","CHECKSUM UPDATE FAIL",CNT3)="DFN= "_DFN_"^ICN= "_ICN_"^CHECKSUM= "_CHECK Q
.S CNT=CNT+1,^XTMP("DG648","CHECKSUM UPDATE",CNT)="DFN= "_DFN_"^ICN= "_ICN_"^CHECKSUM= "_CHECK
S ^XTMP("DG648","CHECKSUM UPDATE",CNT+2)="TOTAL: "_CNT,^XTMP("DG648","MISSING CHECKSUM",CNT2+2)="TOTAL: "_CNT2
S ^XTMP("DG648","CHECKSUM UPDATE FILE",CNT3+2)="TOTAL: "_CNT3
I CNT>0 D
.N DIFROM,XMSUB,XMTEXT,XMY
.S XMSUB="Updated Checksums post-init DG648 from "_$P($$SITE^VASITE,"^",3),XMY(DUZ)=""
.S XMTEXT="^XTMP(""DG648"",""CHECKSUM UPDATE"",",XMY("CHESNEY.CHRISTINE_M@DOMAIN.EXT")=""
.D ^XMD
I CNT2>0 D
.N DIFROM,XMSUB,XMTEXT,XMY
.S XMSUB="Missing Checksums post-init DG648 from "_$P($$SITE^VASITE,"^",3),XMY(DUZ)=""
.S XMTEXT="^XTMP(""DG648"",""MISSING CHECKSUM"",",XMY("CHESNEY.CHRISTINE_M@DOMAIN.EXT")=""
.D ^XMD
I CNT3>0 D
.N DIFROM,XMSUB,XMTEXT,XMY
.S XMSUB="Checksum updates failed in post-init DG648 from "_$P($$SITE^VASITE,"^",3),XMY(DUZ)=""
.S XMTEXT="^XTMP(""DG648"",""CHECKSUM UPDATE FAIL"",",XMY("CHESNEY.CHRISTINE_M@DOMAIN.EXT")=""
.D ^XMD
I CNT=0,CNT2=0,CNT3=0 D
.N DIFROM,XMSUB,XMTEXT,XMY,ARR
.S ARR(1)="No issues with Checksums at this site"
.S XMSUB="Checksum updates failed in post-init DG648 from "_$P($$SITE^VASITE,"^",3),XMY(DUZ)=""
.S XMTEXT="ARR(",XMY("CHESNEY.CHRISTINE_M@DOMAIN.EXT")=""
.D ^XMD
K ^XTMP("DG648","MISSING CHECKSUM"),^XTMP("DG648","CHECKSUM UPDATE"),^XTMP("DG648","CHECKSUM UPDATE FAIL")
Q
;
LOCK(IEN) ;
F L +^DPT(IEN,"MPI"):10 Q:$T
Q
XR(DGFILE,DGFLD) ;File index type cross references
;
N DGFDA,DGIEN,DGWP,DGERR,DGXR,DGVAL,DGOUT,DIERR
;Set up x-refs. Any value that has a ".", will have the period
;replaved with a "D" to prevent x-ref's such as .11 and 11 having
;identical xref names
;I DGFILE=2.0361 S DGXR="AVAFC20361" ;ELIGIBILITY -- MOVED TO DG*5.3*691
I '$D(DGXR) S DGXR=$S(DGFLD[".":"AVAFC"_$P(DGFLD,".",2),1:"AVAFC"_DGFLD)
;Check for existing x-ref
S DGVAL(1)=DGFILE,DGVAL(2)=DGXR
D FIND^DIC(.11,"","@;IXIE","KP",.DGVAL,"","","","","DGOUT")
I $D(DGOUT("DILIST",1)) D Q
.D MES^XPDUTL(" >>> Cross reference "_DGXR_" already exists, nothing filed.")
.Q
;Create filer array
S DGFDA(.11,"+1,",.01)=DGFILE ;FILE
S DGFDA(.11,"+1,",.02)=DGXR ;NAME
S DGFDA(.11,"+1,",.11)="This x-ref calls the DG FIELD MONITOR event point." ;SHORT DESCRIPTION
S DGFDA(.11,"+1,",.2)="MU" ;TYPE
S DGFDA(.11,"+1,",.4)="F" ;EXECUTION
S DGFDA(.11,"+1,",.41)="I" ;ACTIVITY
S DGFDA(.11,"+1,",.5)="I" ;ROOT TYPE
S DGFDA(.11,"+1,",.51)=DGFILE ;ROOT FILE
S DGFDA(.11,"+1,",.42)="A" ;USE
S DGFDA(.11,"+1,",1.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""SET"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q" ;SET LOGIC
S DGFDA(.11,"+1,",2.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""KILL"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q" ;KILL LOGIC
;CROSS REFERENCE VALUES
S DGFDA(.114,"+2,+1,",.01)=1 ;ORDER NUMBER
S DGFDA(.114,"+2,+1,",1)="F" ;TYPE OF VALUE
S DGFDA(.114,"+2,+1,",2)=DGFILE ;FILE NUMBER
S DGFDA(.114,"+2,+1,",3)=DGFLD ;FIELD NUMBER
S DGFDA(.114,"+2,+1,",7)="F" ;COLLATION
;DESCRIPTION
S DGWP(1)="This cross reference activates the DG FIELD MONITOR event point."
S DGWP(2)="Applications that wish to monitor edit activity related to this field may"
S DGWP(3)="subscribe to that event point and take action as indicated by the changes"
S DGWP(4)="that occur. Refer to the DG FIELD MONITOR protocol for a description of"
S DGWP(5)="the information available at the time of the event."
;File INDEX record
D UPDATE^DIE("","DGFDA","DGIEN","DGERR")
I $D(DIERR) D Q
.N DGI S DGI=""
.D MES^XPDUTL(" >>> A problem has occurred during the filing of x-ref. "_DGXR_"!")
.D MES^XPDUTL(" Please contact Customer Support.")
.F S DGI=$O(DGERR("DIERR",1,"TEXT",DGI)) Q:DGI="" D
..D MES^XPDUTL(DGERR("DIERR",1,"TEXT",DGI))
..Q
.Q
S DGFLD(DGFILE,DGFLD)="" ;Create list to recompile templates
D MES^XPDUTL(" >>> "_DGXR_" cross reference filed.")
;File DESCRIPTION field
D WP^DIE(.11,DGIEN(1)_",",.1,"","DGWP")
Q
TEMPL N GLOBAL,FIELD,NFIELD,FILE,CNT
D BMES^XPDUTL("Beginning to compile templates on the PATIENT (#2) file.")
;
S NFIELD=".525",FILE=2,FIELD="",CNT=1
F S FIELD=$P(NFIELD,",",CNT) Q:FIELD="" D LOOP(FIELD,FILE) S CNT=CNT+1
;S NFIELD=.01,FILE=2.0361 D LOOP(NFIELD,FILE) -- MOVED TO DG*5.3*691
W !!
S (X,Y)=""
D BMES^XPDUTL("The following routine namespace was compiled:")
F S X=$O(CFIELD(X)) Q:X="" S Y=$G(Y)+1 S PRINT(Y)=" "_X_"*"
;
D MES^XPDUTL(.PRINT)
K X,Y,PRINT,CFIELD
Q
;
LOOP(FIELD,FILE) ;
N GLOBAL,TEMPLATP,TEMPLATN,X,Y,DMAX
F GLOBAL="^DIE","^DIPT" DO
.I $D(@GLOBAL@("AF",FILE,FIELD)) D
..S TEMPLATP=0
..F S TEMPLATP=$O(@GLOBAL@("AF",FILE,FIELD,TEMPLATP)) Q:'TEMPLATP DO
...S TEMPLATN=$P($G(@GLOBAL@(TEMPLATP,0)),"^",1)
...I TEMPLATN="" D BMES^XPDUTL("Could not compile template "_TEMPLATN_$C(13,10)_"Please review!") Q
...S X=$P($G(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
...I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))'=0) D BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$C(13,10)_"Please review!") Q
...I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))=0) Q
...I $D(CFIELD(X)) Q ;already compiled
...S CFIELD(X)="" ; remember the template was compiled
...S Y=TEMPLATP ; set up the call for fman
...S DMAX=$$ROUSIZE^DILF
...I GLOBAL="^DIE" D BMES^XPDUTL(" "),BMES^XPDUTL(" Compiling Input Templates") D EN^DIEZ Q
...I GLOBAL="^DIPT" D BMES^XPDUTL(" "),BMES^XPDUTL(" Compiling Print Templates") D EN^DIPZ Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG648PST 7492 printed Sep 23, 2025@20:16:21 Page 2
DG648PST ;BIR/CMC-PATCH DG*5.3*648 POST INSTALLATION ROUTINE ;2/11/05
+1 ;;5.3;Registration;**648**;Aug 13, 1993
+2 ;
POST ;Post init
+1 NEW DGFLD,DGMFLD,DGOUT,DGFILE
+2 ;File cross references
+3 ;POW STATUS INDICATED?
DO XR(2,.525)
+4 ;;D XR(2.0361,.01) ;PATIENT ELIGIBILITIES MULTIPLE ELIGIBILITY FIELD -- MOVED TO DG*5.3*691
+5 DO TEMPL
+6 ;fix missing leading zeros for ICN Checksums DD issue was corrected in MPIF*1.0*9
+7 DO MES^XPDUTL(" >>> Checking ICN Checksums for missing leading zeros. Job being tasked off.")
+8 SET ZTRTN="CHKSUM^DG648PST"
SET ZTDESC="Correct missing leading zeros in ICN Checksum - DG*5.3*648"
+9 SET ZTIO=""
SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
+10 IF $DATA(DUZ)
SET ZTSAVE("DUZ")=DUZ
+11 DO ^%ZTLOAD
+12 KILL ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,%
+13 QUIT
+14 ;
CHKSUM ;fix missing leading zeros for ICN Checksums
+1 KILL ^XTMP("DG648","MISSING CHECKSUM"),^XTMP("DG648","CHECKSUM UPDATE"),^XTMP("DG648","CHECKSUM UPDATE FAIL")
+2 NEW DFN,ICN,CHECK,DIE,DA,DR,X,Y,CNT,CNT2,CNT3,LEN
+3 SET (CNT2,CNT3,CNT,ICN)=0
+4 FOR
SET ICN=$ORDER(^DPT("AICN",ICN))
if ICN=""
QUIT
Begin DoDot:1
+5 if $EXTRACT(ICN,1,3)=$PIECE($$SITE^VASITE,"^",3)
QUIT
+6 SET DFN=$ORDER(^DPT("AICN",ICN,""))
+7 IF ICN'=$PIECE($GET(^DPT(DFN,"MPI")),"^")
QUIT
+8 ; ^ ONLY UPDATING PRIMARY ICN
+9 SET CHECK=$PIECE($GET(^DPT(DFN,"MPI")),"^",2)
+10 IF CHECK=""
SET CNT2=CNT2+1
SET ^XTMP("DG648","MISSING CHECKSUM",CNT2)="DFN= "_DFN_"^"_"ICN= "_ICN
QUIT
+11 SET LEN=$LENGTH(CHECK)
+12 if LEN=6
QUIT
+13 ;adding missing leading zeros
IF LEN<6
SET CHECK=$EXTRACT(1000000+CHECK,2,7)
+14 KILL X,Y,DIE,DA,DR
+15 SET DA=DFN
+16 ;LOCK DPT NODE "MPI"
DO LOCK(DA)
+17 SET DIE="^DPT("
SET DR="991.02///^S X=CHECK"
DO ^DIE
+18 LOCK -^DPT(DA,"MPI")
+19 IF +$GET(Y)=-1
SET CNT3=CNT3+1
SET ^XTMP("DG648","CHECKSUM UPDATE FAIL",CNT3)="DFN= "_DFN_"^ICN= "_ICN_"^CHECKSUM= "_CHECK
QUIT
+20 SET CNT=CNT+1
SET ^XTMP("DG648","CHECKSUM UPDATE",CNT)="DFN= "_DFN_"^ICN= "_ICN_"^CHECKSUM= "_CHECK
End DoDot:1
+21 SET ^XTMP("DG648","CHECKSUM UPDATE",CNT+2)="TOTAL: "_CNT
SET ^XTMP("DG648","MISSING CHECKSUM",CNT2+2)="TOTAL: "_CNT2
+22 SET ^XTMP("DG648","CHECKSUM UPDATE FILE",CNT3+2)="TOTAL: "_CNT3
+23 IF CNT>0
Begin DoDot:1
+24 NEW DIFROM,XMSUB,XMTEXT,XMY
+25 SET XMSUB="Updated Checksums post-init DG648 from "_$PIECE($$SITE^VASITE,"^",3)
SET XMY(DUZ)=""
+26 SET XMTEXT="^XTMP(""DG648"",""CHECKSUM UPDATE"","
SET XMY("CHESNEY.CHRISTINE_M@DOMAIN.EXT")=""
+27 DO ^XMD
End DoDot:1
+28 IF CNT2>0
Begin DoDot:1
+29 NEW DIFROM,XMSUB,XMTEXT,XMY
+30 SET XMSUB="Missing Checksums post-init DG648 from "_$PIECE($$SITE^VASITE,"^",3)
SET XMY(DUZ)=""
+31 SET XMTEXT="^XTMP(""DG648"",""MISSING CHECKSUM"","
SET XMY("CHESNEY.CHRISTINE_M@DOMAIN.EXT")=""
+32 DO ^XMD
End DoDot:1
+33 IF CNT3>0
Begin DoDot:1
+34 NEW DIFROM,XMSUB,XMTEXT,XMY
+35 SET XMSUB="Checksum updates failed in post-init DG648 from "_$PIECE($$SITE^VASITE,"^",3)
SET XMY(DUZ)=""
+36 SET XMTEXT="^XTMP(""DG648"",""CHECKSUM UPDATE FAIL"","
SET XMY("CHESNEY.CHRISTINE_M@DOMAIN.EXT")=""
+37 DO ^XMD
End DoDot:1
+38 IF CNT=0
IF CNT2=0
IF CNT3=0
Begin DoDot:1
+39 NEW DIFROM,XMSUB,XMTEXT,XMY,ARR
+40 SET ARR(1)="No issues with Checksums at this site"
+41 SET XMSUB="Checksum updates failed in post-init DG648 from "_$PIECE($$SITE^VASITE,"^",3)
SET XMY(DUZ)=""
+42 SET XMTEXT="ARR("
SET XMY("CHESNEY.CHRISTINE_M@DOMAIN.EXT")=""
+43 DO ^XMD
End DoDot:1
+44 KILL ^XTMP("DG648","MISSING CHECKSUM"),^XTMP("DG648","CHECKSUM UPDATE"),^XTMP("DG648","CHECKSUM UPDATE FAIL")
+45 QUIT
+46 ;
LOCK(IEN) ;
+1 FOR
LOCK +^DPT(IEN,"MPI"):10
if $TEST
QUIT
+2 QUIT
XR(DGFILE,DGFLD) ;File index type cross references
+1 ;
+2 NEW DGFDA,DGIEN,DGWP,DGERR,DGXR,DGVAL,DGOUT,DIERR
+3 ;Set up x-refs. Any value that has a ".", will have the period
+4 ;replaved with a "D" to prevent x-ref's such as .11 and 11 having
+5 ;identical xref names
+6 ;I DGFILE=2.0361 S DGXR="AVAFC20361" ;ELIGIBILITY -- MOVED TO DG*5.3*691
+7 IF '$DATA(DGXR)
SET DGXR=$SELECT(DGFLD[".":"AVAFC"_$PIECE(DGFLD,".",2),1:"AVAFC"_DGFLD)
+8 ;Check for existing x-ref
+9 SET DGVAL(1)=DGFILE
SET DGVAL(2)=DGXR
+10 DO FIND^DIC(.11,"","@;IXIE","KP",.DGVAL,"","","","","DGOUT")
+11 IF $DATA(DGOUT("DILIST",1))
Begin DoDot:1
+12 DO MES^XPDUTL(" >>> Cross reference "_DGXR_" already exists, nothing filed.")
+13 QUIT
End DoDot:1
QUIT
+14 ;Create filer array
+15 ;FILE
SET DGFDA(.11,"+1,",.01)=DGFILE
+16 ;NAME
SET DGFDA(.11,"+1,",.02)=DGXR
+17 ;SHORT DESCRIPTION
SET DGFDA(.11,"+1,",.11)="This x-ref calls the DG FIELD MONITOR event point."
+18 ;TYPE
SET DGFDA(.11,"+1,",.2)="MU"
+19 ;EXECUTION
SET DGFDA(.11,"+1,",.4)="F"
+20 ;ACTIVITY
SET DGFDA(.11,"+1,",.41)="I"
+21 ;ROOT TYPE
SET DGFDA(.11,"+1,",.5)="I"
+22 ;ROOT FILE
SET DGFDA(.11,"+1,",.51)=DGFILE
+23 ;USE
SET DGFDA(.11,"+1,",.42)="A"
+24 ;SET LOGIC
SET DGFDA(.11,"+1,",1.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""SET"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q"
+25 ;KILL LOGIC
SET DGFDA(.11,"+1,",2.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""KILL"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q"
+26 ;CROSS REFERENCE VALUES
+27 ;ORDER NUMBER
SET DGFDA(.114,"+2,+1,",.01)=1
+28 ;TYPE OF VALUE
SET DGFDA(.114,"+2,+1,",1)="F"
+29 ;FILE NUMBER
SET DGFDA(.114,"+2,+1,",2)=DGFILE
+30 ;FIELD NUMBER
SET DGFDA(.114,"+2,+1,",3)=DGFLD
+31 ;COLLATION
SET DGFDA(.114,"+2,+1,",7)="F"
+32 ;DESCRIPTION
+33 SET DGWP(1)="This cross reference activates the DG FIELD MONITOR event point."
+34 SET DGWP(2)="Applications that wish to monitor edit activity related to this field may"
+35 SET DGWP(3)="subscribe to that event point and take action as indicated by the changes"
+36 SET DGWP(4)="that occur. Refer to the DG FIELD MONITOR protocol for a description of"
+37 SET DGWP(5)="the information available at the time of the event."
+38 ;File INDEX record
+39 DO UPDATE^DIE("","DGFDA","DGIEN","DGERR")
+40 IF $DATA(DIERR)
Begin DoDot:1
+41 NEW DGI
SET DGI=""
+42 DO MES^XPDUTL(" >>> A problem has occurred during the filing of x-ref. "_DGXR_"!")
+43 DO MES^XPDUTL(" Please contact Customer Support.")
+44 FOR
SET DGI=$ORDER(DGERR("DIERR",1,"TEXT",DGI))
if DGI=""
QUIT
Begin DoDot:2
+45 DO MES^XPDUTL(DGERR("DIERR",1,"TEXT",DGI))
+46 QUIT
End DoDot:2
+47 QUIT
End DoDot:1
QUIT
+48 ;Create list to recompile templates
SET DGFLD(DGFILE,DGFLD)=""
+49 DO MES^XPDUTL(" >>> "_DGXR_" cross reference filed.")
+50 ;File DESCRIPTION field
+51 DO WP^DIE(.11,DGIEN(1)_",",.1,"","DGWP")
+52 QUIT
TEMPL NEW GLOBAL,FIELD,NFIELD,FILE,CNT
+1 DO BMES^XPDUTL("Beginning to compile templates on the PATIENT (#2) file.")
+2 ;
+3 SET NFIELD=".525"
SET FILE=2
SET FIELD=""
SET CNT=1
+4 FOR
SET FIELD=$PIECE(NFIELD,",",CNT)
if FIELD=""
QUIT
DO LOOP(FIELD,FILE)
SET CNT=CNT+1
+5 ;S NFIELD=.01,FILE=2.0361 D LOOP(NFIELD,FILE) -- MOVED TO DG*5.3*691
+6 WRITE !!
+7 SET (X,Y)=""
+8 DO BMES^XPDUTL("The following routine namespace was compiled:")
+9 FOR
SET X=$ORDER(CFIELD(X))
if X=""
QUIT
SET Y=$GET(Y)+1
SET PRINT(Y)=" "_X_"*"
+10 ;
+11 DO MES^XPDUTL(.PRINT)
+12 KILL X,Y,PRINT,CFIELD
+13 QUIT
+14 ;
LOOP(FIELD,FILE) ;
+1 NEW GLOBAL,TEMPLATP,TEMPLATN,X,Y,DMAX
+2 FOR GLOBAL="^DIE","^DIPT"
Begin DoDot:1
+3 IF $DATA(@GLOBAL@("AF",FILE,FIELD))
Begin DoDot:2
+4 SET TEMPLATP=0
+5 FOR
SET TEMPLATP=$ORDER(@GLOBAL@("AF",FILE,FIELD,TEMPLATP))
if 'TEMPLATP
QUIT
Begin DoDot:3
+6 SET TEMPLATN=$PIECE($GET(@GLOBAL@(TEMPLATP,0)),"^",1)
+7 IF TEMPLATN=""
DO BMES^XPDUTL("Could not compile template "_TEMPLATN_$CHAR(13,10)_"Please review!")
QUIT
+8 SET X=$PIECE($GET(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
+9 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))'=0)
DO BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$CHAR(13,10)_"Please review!")
QUIT
+10 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))=0)
QUIT
+11 ;already compiled
IF $DATA(CFIELD(X))
QUIT
+12 ; remember the template was compiled
SET CFIELD(X)=""
+13 ; set up the call for fman
SET Y=TEMPLATP
+14 SET DMAX=$$ROUSIZE^DILF
+15 IF GLOBAL="^DIE"
DO BMES^XPDUTL(" ")
DO BMES^XPDUTL(" Compiling Input Templates")
DO EN^DIEZ
QUIT
+16 IF GLOBAL="^DIPT"
DO BMES^XPDUTL(" ")
DO BMES^XPDUTL(" Compiling Print Templates")
DO EN^DIPZ
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
