PRC153P ;WOIFO/KCL - PRC*5.1*153 INSTALL UTILITIES ;2/24/2011
V ;;5.1;IFCAP;**153**;Oct 20, 2000;Build 10
;
;--------------------------------------------------
;Patch PRC*5.1*153: 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=""
;
;item 1 - check programmer variables
W !!,">>> Check programmer variables..."
D PROGCHK(.XPDABORT)
Q:XPDABORT=2
W "Successful"
;
;item 2 - check for Domain entry
W !!,">>> Check for DOMAIN (#4.2) file entry..."
D DOMCHK(.XPDABORT)
Q:XPDABORT=2
W "Successful"
;
;success
I XPDABORT="" K XPDABORT
Q
;
;
PRE ;Main entry point for Pre-init items
Q
;
;
POST ;Main entry point for Post-init items
;
; Supported IAs:
; #10141 Allows use of supported Kernel call BMES^XPDUTL
;
;item 1 - add mail group member
D BMES^XPDUTL(">>> Adding member to 'OLP' mail group...")
D POST1
;
;item 2 - queue initial data extract
N PRCOK
D BMES^XPDUTL(">>> Queue job to perform data extract of 1358 transactions...")
D OK(.PRCOK) ;ok to run extract?
I PRCOK D POST2 ;queue extract
Q
;
;
PROGCHK(XPDABORT) ;Check for required programmer variables
;
; This procedure will determine if the users programmer variable 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 PRC*5.1*153."
. W !," **********"
. ;tell KIDS to abort the entire installation of the distribution
. S XPDABORT=2
Q
;
;
DOMCHK(XPDABORT) ;Check for new DOMAIN (#4.2) file entry
;
; This procedure will determine if DOMAIN (#4.2) file entry was added
; per MailMan patch XM*999*175.
;
; Per KIDS documentation: During the environment check routine,
; use of direct WRITEs must be used for output messages.
;
; Supported IAs:
; #3452 Allows use of supported FM call $$FIND1^DIC
; #3779 Allows read with FM on the NAME (#.01) field in the DOMAIN (#4.2)
; file to ensure that the domain Q-OLP.DOMAIN.EXT exists
;
; Input:
; XPDABORT - KIDS var to indicate if install should
; abort, passed by reference
;
; Output:
; XPDABORT - if = 2, then abort entire installation
;
I '$$FIND1^DIC(4.2,"","MX","Q-OLP.DOMAIN.EXT") D
. W !!," **********"
. W !," ERROR: Environment check failed!"
. W !," The required DOMAIN (#4.2) file entry was not found"
. W !," for 'Q-OLP.DOMAIN.EXT'. Please refer to MailMan patch"
. W !," XM*999*175 to create this new entry. After the DOMAIN"
. W !," entry has been created, re-install this patch PRC*5.1*153."
. W !," **********"
. ;tell KIDS to abort the entire installation of the distribution
. S XPDABORT=2
Q
;
;
OK(PRCOK) ;Ok to queue initial data extract?
;
; This procedure will determine if it's ok to queue the initial
; data extract.
;
; Queuing will not be allowed if:
; [Not a production system]
; OR
; [Job is already running]
; OR
; [Job has been run previously]
;
; Supported IAs:
; #10141 Allows use of supported Kernel call BMES^XPDUTL and MES^XPDUTL
; #4440 Allows use of supported Kernel call $$PROD^XUPROD
; #2263 Allows use of supported Kernel call $$GET^XPAR
;
; Input:
; PRCOK - ok to queue initial data extract?, passed by reference
;
; Output:
; PRCOK - 1 if ok to queue, 0 if not ok
;
N PRCTASK ;task #
N PRCVAL ;result of $$GET^XPAR function
;
S PRCOK=1
;
;short circuit if not a production system
I '$$PROD^XUPROD(1) D Q
. S PRCOK=0
. D BMES^XPDUTL(" **********")
. D MES^XPDUTL(" WARNING: This is not a production system.")
. D MES^XPDUTL(" The job to perform an initial data extract of 1358")
. D MES^XPDUTL(" transactions and transmit them to the Online")
. D MES^XPDUTL(" Certification System will not be queued.")
. D MES^XPDUTL(" **********")
;
;short circuit if job already running
S PRCTASK=$G(^XTMP("PRC153P","TASK"))
I +PRCTASK D Q
. I $$STATUS(PRCTASK)>0 D
. . S PRCOK=0
. . D BMES^XPDUTL(" **********")
. . D MES^XPDUTL(" WARNING: Duplicate processes cannot be started.")
. . D MES^XPDUTL(" The job to perform an initial data extract of 1358")
. . D MES^XPDUTL(" transactions and transmit them to the Online")
. . D MES^XPDUTL(" Certification System is already running.")
. . D MES^XPDUTL(" The task number is "_PRCTASK)
. . D MES^XPDUTL(" **********")
;
;short circuit if job has been run previously
S PRCVAL=$$GET^XPAR("SYS","PRC OLCS 1358 EXTRACT",1,"E")
I $G(PRCVAL)]"" D Q
. S PRCOK=0
. D BMES^XPDUTL(" **********")
. D MES^XPDUTL(" WARNING: The job has been run previously.")
. D MES^XPDUTL(" The job to perform an initial data extract of 1358")
. D MES^XPDUTL(" transactions and transmit them to the Online")
. D MES^XPDUTL(" Certification System will not be queued.")
. D MES^XPDUTL(" The job completed on "_PRCVAL)
. D MES^XPDUTL(" **********")
Q
;
;
POST1 ;Add member to OLP mail group
;
; This procedure adds the installer or Postmaster as a new member to
; the OLP mail group.
;
; Supported IAs:
; #10141 Allows use of supported Kernel call BMES^XPDUTL and MES^XPDUTL
; #10067 Allows use of supported Mailman call CHK^XMA21
; #1146 Allows use of supported Mailman call $$MG^XMBGRP
; #2051 Allows use of supported FM call $$FIND1^DIC
;
; Input: None
; Output: None
;
N PRCDUZ ;installer DUZ, otherwise Postmaster
N PRCIEN ;IEN of the mail group in the MAIL GROUP file (#3.8)
N PRCMEM ;text used in success msg
N PRCTXT ;array of text to put in description field of mail group
N PRCXMY ;array of local users to add to the mail group
;
;short circuit if mail group does not exist
S PRCIEN=$$FIND1^DIC(3.8,"","X","OLP","B")
I 'PRCIEN D Q
. D BMES^XPDUTL(" **********")
. D MES^XPDUTL(" ERROR: The OLP Mail Group does not exist!")
. D MES^XPDUTL("")
. D MES^XPDUTL(" Please enter a Remedy ticket for assistance.")
. D MES^XPDUTL(" **********")
;
S PRCDUZ=$S(+$G(DUZ)>0:DUZ,1:.5)
S PRCXMY(PRCDUZ)=""
S PRCMEM=$S(PRCDUZ=.5:"Postmaster",1:"Installer")
S PRCTXT(0)="" ;required for $$MG^XMBGRP call, ignored if not creating mail group
;
;short circuit if installer is already a member
N Y ;IEN of the mail group in the MAIL GROUP file (#3.8)
N XMDUZ ;DUZ of user to look for
S XMDUZ=PRCDUZ
S Y=PRCIEN
D CHK^XMA21
I $T D Q
. D BMES^XPDUTL(" **********")
. D MES^XPDUTL(" WARNING: "_PRCMEM_" is already a member of the OLP mail")
. D MES^XPDUTL(" group. No action required.")
. D MES^XPDUTL(" **********")
;
;add mail group member (silent call to MailMan API)
I $$MG^XMBGRP("OLP",0,PRCDUZ,0,.PRCXMY,.PRCTXT,1) D
. D BMES^XPDUTL(" **********")
. D MES^XPDUTL(" SUCCESS: "_PRCMEM_" successfully added as a member")
. D MES^XPDUTL(" to the OLP Mail Group.")
. D MES^XPDUTL("")
. D MES^XPDUTL(" After the patch installation, please enter other members")
. D MES^XPDUTL(" as appropriate.")
. D MES^XPDUTL(" **********")
E D
. D BMES^XPDUTL(" **********")
. D MES^XPDUTL(" ERROR: No members could be added to the OLP Mail Group!")
. D MES^XPDUTL("")
. D MES^XPDUTL(" Please enter a Remedy ticket for assistance.")
. D MES^XPDUTL(" **********")
Q
;
;
POST2 ;Queue initial data extract
;
; This procedure is responsible for queuing the initial data extract.
; Upon queuing the job, the task number assigned will be placed in
; the ^XTMP global.
;
; Input: None
; Output: None
;
; Supported IAs:
; #10141 Allows use of supported Kernel call BMES^XPDUTL and MES^XPDUTL
; #10103 Allows use of supported Kernel call $$FMADD^XLFDT
; #10063 Allows use of supported Kernel call ^%ZTLOAD
;
N ZTRTN ;the API TaskMan will DO to start the task
N ZTDESC ;task description
N ZTSK ;task number assigned to the task
N ZTSAVE ;save input variables to the task
N ZTIO ;(optional) I/O device the task should use
N ZTDTH ;(optional) start time when TaskMan should start the task
;
K ^XTMP("PRC153P")
S ZTRTN="EXTRACT^PRCFDO1"
S ZTDESC="PRC*5.1*153 INITIAL EXTRACT OF 1358 TRANSACTIONS"
S ZTIO=""
S ZTSAVE("DUZ")=""
S ZTDTH=$$NOW^XLFDT
D ^%ZTLOAD
;success
I $G(ZTSK) D
. S ^XTMP("PRC153P",0)=$$FMADD^XLFDT(DT,3)_"^"_DT_"^"_"PRC*5.1*153 Initial extract 1358 transactions"
. S ^XTMP("PRC153P","TASK")=ZTSK
. D BMES^XPDUTL(" **********")
. D MES^XPDUTL(" SUCCESS: Job was queued.")
. D MES^XPDUTL(" The job to perform an initial data extract of 1358")
. D MES^XPDUTL(" transactions and transmit them to the Online")
. D MES^XPDUTL(" Certification System was successfully queued.")
. D MES^XPDUTL(" The task number is "_ZTSK)
. D MES^XPDUTL(" **********")
;failure
I '$G(ZTSK) D
. D BMES^XPDUTL(" **********")
. D MES^XPDUTL(" ERROR: Job was not queued!")
. D MES^XPDUTL(" The job to perform an initial data extract of 1358")
. D MES^XPDUTL(" transactions and transmit them to the Online")
. D MES^XPDUTL(" Certification System was not successfully queued.")
. D MES^XPDUTL(" Please enter a Remedy ticket for assistance.")
. D MES^XPDUTL(" **********")
Q
;
;
STATUS(PRCTASK) ;Determine status of a task
;
; This procedure will determine the status of a task.
;
; Supported IAs:
; #10063 Allows use of supported Kernel call STAT^%ZTLOAD
;
; Input:
; PRCTASK - task number to lookup
;
; Output:
; Function Value - Returns 1 if task has finished, 0 otherwise
;
N ZTSK
N RESULT
S RESULT=0
S ZTSK=+$G(PRCTASK)
D STAT^%ZTLOAD
;
D ;drops out of DO block on failure
. Q:ZTSK(0)=0 ;Undefined task
. Q:ZTSK(1)=1 ;Active: Pending
. Q:ZTSK(1)=2 ;Active: Running
. Q:ZTSK(1)=4 ;Inactive: Available
. Q:ZTSK(1)=5 ;Inactive: Interrupted
. S RESULT=1
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC153P 10940 printed Sep 23, 2025@19:35:24 Page 2
PRC153P ;WOIFO/KCL - PRC*5.1*153 INSTALL UTILITIES ;2/24/2011
V ;;5.1;IFCAP;**153**;Oct 20, 2000;Build 10
+1 ;
+2 ;--------------------------------------------------
+3 ;Patch PRC*5.1*153: Environment, Pre-Install, and
+4 ;Post-Install entry points.
+5 ;--------------------------------------------------
+6 ;
ENV ;Main entry point for Environment check items
+1 ;
+2 ; Per KIDS documentation: During the environment check routine,
+3 ; use of direct WRITEs must be used for output messages.
+4 ;
+5 ;KIDS variable to indicate if install should abort
+6 ;if SET = 2, then abort entire installation
+7 SET XPDABORT=""
+8 ;
+9 ;item 1 - check programmer variables
+10 WRITE !!,">>> Check programmer variables..."
+11 DO PROGCHK(.XPDABORT)
+12 if XPDABORT=2
QUIT
+13 WRITE "Successful"
+14 ;
+15 ;item 2 - check for Domain entry
+16 WRITE !!,">>> Check for DOMAIN (#4.2) file entry..."
+17 DO DOMCHK(.XPDABORT)
+18 if XPDABORT=2
QUIT
+19 WRITE "Successful"
+20 ;
+21 ;success
+22 IF XPDABORT=""
KILL XPDABORT
+23 QUIT
+24 ;
+25 ;
PRE ;Main entry point for Pre-init items
+1 QUIT
+2 ;
+3 ;
POST ;Main entry point for Post-init items
+1 ;
+2 ; Supported IAs:
+3 ; #10141 Allows use of supported Kernel call BMES^XPDUTL
+4 ;
+5 ;item 1 - add mail group member
+6 DO BMES^XPDUTL(">>> Adding member to 'OLP' mail group...")
+7 DO POST1
+8 ;
+9 ;item 2 - queue initial data extract
+10 NEW PRCOK
+11 DO BMES^XPDUTL(">>> Queue job to perform data extract of 1358 transactions...")
+12 ;ok to run extract?
DO OK(.PRCOK)
+13 ;queue extract
IF PRCOK
DO POST2
+14 QUIT
+15 ;
+16 ;
PROGCHK(XPDABORT) ;Check for required programmer variables
+1 ;
+2 ; This procedure will determine if the users programmer variable are set up.
+3 ;
+4 ; Per KIDS documentation: During the environment check routine,
+5 ; use of direct WRITEs must be used for output messages.
+6 ;
+7 ; Input:
+8 ; XPDABORT - KIDS var to indicate if install should
+9 ; abort, passed by reference
+10 ;
+11 ; Output:
+12 ; XPDABORT - if = 2, then abort entire installation
+13 ;
+14 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+15 WRITE !!," **********"
+16 WRITE !," ERROR: Environment check failed!"
+17 WRITE !," Your programming variables are not set up properly. Once"
+18 WRITE !," your programming variables are set up correctly, re-install"
+19 WRITE !," this patch PRC*5.1*153."
+20 WRITE !," **********"
+21 ;tell KIDS to abort the entire installation of the distribution
+22 SET XPDABORT=2
End DoDot:1
+23 QUIT
+24 ;
+25 ;
DOMCHK(XPDABORT) ;Check for new DOMAIN (#4.2) file entry
+1 ;
+2 ; This procedure will determine if DOMAIN (#4.2) file entry was added
+3 ; per MailMan patch XM*999*175.
+4 ;
+5 ; Per KIDS documentation: During the environment check routine,
+6 ; use of direct WRITEs must be used for output messages.
+7 ;
+8 ; Supported IAs:
+9 ; #3452 Allows use of supported FM call $$FIND1^DIC
+10 ; #3779 Allows read with FM on the NAME (#.01) field in the DOMAIN (#4.2)
+11 ; file to ensure that the domain Q-OLP.DOMAIN.EXT exists
+12 ;
+13 ; Input:
+14 ; XPDABORT - KIDS var to indicate if install should
+15 ; abort, passed by reference
+16 ;
+17 ; Output:
+18 ; XPDABORT - if = 2, then abort entire installation
+19 ;
+20 IF '$$FIND1^DIC(4.2,"","MX","Q-OLP.DOMAIN.EXT")
Begin DoDot:1
+21 WRITE !!," **********"
+22 WRITE !," ERROR: Environment check failed!"
+23 WRITE !," The required DOMAIN (#4.2) file entry was not found"
+24 WRITE !," for 'Q-OLP.DOMAIN.EXT'. Please refer to MailMan patch"
+25 WRITE !," XM*999*175 to create this new entry. After the DOMAIN"
+26 WRITE !," entry has been created, re-install this patch PRC*5.1*153."
+27 WRITE !," **********"
+28 ;tell KIDS to abort the entire installation of the distribution
+29 SET XPDABORT=2
End DoDot:1
+30 QUIT
+31 ;
+32 ;
OK(PRCOK) ;Ok to queue initial data extract?
+1 ;
+2 ; This procedure will determine if it's ok to queue the initial
+3 ; data extract.
+4 ;
+5 ; Queuing will not be allowed if:
+6 ; [Not a production system]
+7 ; OR
+8 ; [Job is already running]
+9 ; OR
+10 ; [Job has been run previously]
+11 ;
+12 ; Supported IAs:
+13 ; #10141 Allows use of supported Kernel call BMES^XPDUTL and MES^XPDUTL
+14 ; #4440 Allows use of supported Kernel call $$PROD^XUPROD
+15 ; #2263 Allows use of supported Kernel call $$GET^XPAR
+16 ;
+17 ; Input:
+18 ; PRCOK - ok to queue initial data extract?, passed by reference
+19 ;
+20 ; Output:
+21 ; PRCOK - 1 if ok to queue, 0 if not ok
+22 ;
+23 ;task #
NEW PRCTASK
+24 ;result of $$GET^XPAR function
NEW PRCVAL
+25 ;
+26 SET PRCOK=1
+27 ;
+28 ;short circuit if not a production system
+29 IF '$$PROD^XUPROD(1)
Begin DoDot:1
+30 SET PRCOK=0
+31 DO BMES^XPDUTL(" **********")
+32 DO MES^XPDUTL(" WARNING: This is not a production system.")
+33 DO MES^XPDUTL(" The job to perform an initial data extract of 1358")
+34 DO MES^XPDUTL(" transactions and transmit them to the Online")
+35 DO MES^XPDUTL(" Certification System will not be queued.")
+36 DO MES^XPDUTL(" **********")
End DoDot:1
QUIT
+37 ;
+38 ;short circuit if job already running
+39 SET PRCTASK=$GET(^XTMP("PRC153P","TASK"))
+40 IF +PRCTASK
Begin DoDot:1
+41 IF $$STATUS(PRCTASK)>0
Begin DoDot:2
+42 SET PRCOK=0
+43 DO BMES^XPDUTL(" **********")
+44 DO MES^XPDUTL(" WARNING: Duplicate processes cannot be started.")
+45 DO MES^XPDUTL(" The job to perform an initial data extract of 1358")
+46 DO MES^XPDUTL(" transactions and transmit them to the Online")
+47 DO MES^XPDUTL(" Certification System is already running.")
+48 DO MES^XPDUTL(" The task number is "_PRCTASK)
+49 DO MES^XPDUTL(" **********")
End DoDot:2
End DoDot:1
QUIT
+50 ;
+51 ;short circuit if job has been run previously
+52 SET PRCVAL=$$GET^XPAR("SYS","PRC OLCS 1358 EXTRACT",1,"E")
+53 IF $GET(PRCVAL)]""
Begin DoDot:1
+54 SET PRCOK=0
+55 DO BMES^XPDUTL(" **********")
+56 DO MES^XPDUTL(" WARNING: The job has been run previously.")
+57 DO MES^XPDUTL(" The job to perform an initial data extract of 1358")
+58 DO MES^XPDUTL(" transactions and transmit them to the Online")
+59 DO MES^XPDUTL(" Certification System will not be queued.")
+60 DO MES^XPDUTL(" The job completed on "_PRCVAL)
+61 DO MES^XPDUTL(" **********")
End DoDot:1
QUIT
+62 QUIT
+63 ;
+64 ;
POST1 ;Add member to OLP mail group
+1 ;
+2 ; This procedure adds the installer or Postmaster as a new member to
+3 ; the OLP mail group.
+4 ;
+5 ; Supported IAs:
+6 ; #10141 Allows use of supported Kernel call BMES^XPDUTL and MES^XPDUTL
+7 ; #10067 Allows use of supported Mailman call CHK^XMA21
+8 ; #1146 Allows use of supported Mailman call $$MG^XMBGRP
+9 ; #2051 Allows use of supported FM call $$FIND1^DIC
+10 ;
+11 ; Input: None
+12 ; Output: None
+13 ;
+14 ;installer DUZ, otherwise Postmaster
NEW PRCDUZ
+15 ;IEN of the mail group in the MAIL GROUP file (#3.8)
NEW PRCIEN
+16 ;text used in success msg
NEW PRCMEM
+17 ;array of text to put in description field of mail group
NEW PRCTXT
+18 ;array of local users to add to the mail group
NEW PRCXMY
+19 ;
+20 ;short circuit if mail group does not exist
+21 SET PRCIEN=$$FIND1^DIC(3.8,"","X","OLP","B")
+22 IF 'PRCIEN
Begin DoDot:1
+23 DO BMES^XPDUTL(" **********")
+24 DO MES^XPDUTL(" ERROR: The OLP Mail Group does not exist!")
+25 DO MES^XPDUTL("")
+26 DO MES^XPDUTL(" Please enter a Remedy ticket for assistance.")
+27 DO MES^XPDUTL(" **********")
End DoDot:1
QUIT
+28 ;
+29 SET PRCDUZ=$SELECT(+$GET(DUZ)>0:DUZ,1:.5)
+30 SET PRCXMY(PRCDUZ)=""
+31 SET PRCMEM=$SELECT(PRCDUZ=.5:"Postmaster",1:"Installer")
+32 ;required for $$MG^XMBGRP call, ignored if not creating mail group
SET PRCTXT(0)=""
+33 ;
+34 ;short circuit if installer is already a member
+35 ;IEN of the mail group in the MAIL GROUP file (#3.8)
NEW Y
+36 ;DUZ of user to look for
NEW XMDUZ
+37 SET XMDUZ=PRCDUZ
+38 SET Y=PRCIEN
+39 DO CHK^XMA21
+40 IF $TEST
Begin DoDot:1
+41 DO BMES^XPDUTL(" **********")
+42 DO MES^XPDUTL(" WARNING: "_PRCMEM_" is already a member of the OLP mail")
+43 DO MES^XPDUTL(" group. No action required.")
+44 DO MES^XPDUTL(" **********")
End DoDot:1
QUIT
+45 ;
+46 ;add mail group member (silent call to MailMan API)
+47 IF $$MG^XMBGRP("OLP",0,PRCDUZ,0,.PRCXMY,.PRCTXT,1)
Begin DoDot:1
+48 DO BMES^XPDUTL(" **********")
+49 DO MES^XPDUTL(" SUCCESS: "_PRCMEM_" successfully added as a member")
+50 DO MES^XPDUTL(" to the OLP Mail Group.")
+51 DO MES^XPDUTL("")
+52 DO MES^XPDUTL(" After the patch installation, please enter other members")
+53 DO MES^XPDUTL(" as appropriate.")
+54 DO MES^XPDUTL(" **********")
End DoDot:1
+55 IF '$TEST
Begin DoDot:1
+56 DO BMES^XPDUTL(" **********")
+57 DO MES^XPDUTL(" ERROR: No members could be added to the OLP Mail Group!")
+58 DO MES^XPDUTL("")
+59 DO MES^XPDUTL(" Please enter a Remedy ticket for assistance.")
+60 DO MES^XPDUTL(" **********")
End DoDot:1
+61 QUIT
+62 ;
+63 ;
POST2 ;Queue initial data extract
+1 ;
+2 ; This procedure is responsible for queuing the initial data extract.
+3 ; Upon queuing the job, the task number assigned will be placed in
+4 ; the ^XTMP global.
+5 ;
+6 ; Input: None
+7 ; Output: None
+8 ;
+9 ; Supported IAs:
+10 ; #10141 Allows use of supported Kernel call BMES^XPDUTL and MES^XPDUTL
+11 ; #10103 Allows use of supported Kernel call $$FMADD^XLFDT
+12 ; #10063 Allows use of supported Kernel call ^%ZTLOAD
+13 ;
+14 ;the API TaskMan will DO to start the task
NEW ZTRTN
+15 ;task description
NEW ZTDESC
+16 ;task number assigned to the task
NEW ZTSK
+17 ;save input variables to the task
NEW ZTSAVE
+18 ;(optional) I/O device the task should use
NEW ZTIO
+19 ;(optional) start time when TaskMan should start the task
NEW ZTDTH
+20 ;
+21 KILL ^XTMP("PRC153P")
+22 SET ZTRTN="EXTRACT^PRCFDO1"
+23 SET ZTDESC="PRC*5.1*153 INITIAL EXTRACT OF 1358 TRANSACTIONS"
+24 SET ZTIO=""
+25 SET ZTSAVE("DUZ")=""
+26 SET ZTDTH=$$NOW^XLFDT
+27 DO ^%ZTLOAD
+28 ;success
+29 IF $GET(ZTSK)
Begin DoDot:1
+30 SET ^XTMP("PRC153P",0)=$$FMADD^XLFDT(DT,3)_"^"_DT_"^"_"PRC*5.1*153 Initial extract 1358 transactions"
+31 SET ^XTMP("PRC153P","TASK")=ZTSK
+32 DO BMES^XPDUTL(" **********")
+33 DO MES^XPDUTL(" SUCCESS: Job was queued.")
+34 DO MES^XPDUTL(" The job to perform an initial data extract of 1358")
+35 DO MES^XPDUTL(" transactions and transmit them to the Online")
+36 DO MES^XPDUTL(" Certification System was successfully queued.")
+37 DO MES^XPDUTL(" The task number is "_ZTSK)
+38 DO MES^XPDUTL(" **********")
End DoDot:1
+39 ;failure
+40 IF '$GET(ZTSK)
Begin DoDot:1
+41 DO BMES^XPDUTL(" **********")
+42 DO MES^XPDUTL(" ERROR: Job was not queued!")
+43 DO MES^XPDUTL(" The job to perform an initial data extract of 1358")
+44 DO MES^XPDUTL(" transactions and transmit them to the Online")
+45 DO MES^XPDUTL(" Certification System was not successfully queued.")
+46 DO MES^XPDUTL(" Please enter a Remedy ticket for assistance.")
+47 DO MES^XPDUTL(" **********")
End DoDot:1
+48 QUIT
+49 ;
+50 ;
STATUS(PRCTASK) ;Determine status of a task
+1 ;
+2 ; This procedure will determine the status of a task.
+3 ;
+4 ; Supported IAs:
+5 ; #10063 Allows use of supported Kernel call STAT^%ZTLOAD
+6 ;
+7 ; Input:
+8 ; PRCTASK - task number to lookup
+9 ;
+10 ; Output:
+11 ; Function Value - Returns 1 if task has finished, 0 otherwise
+12 ;
+13 NEW ZTSK
+14 NEW RESULT
+15 SET RESULT=0
+16 SET ZTSK=+$GET(PRCTASK)
+17 DO STAT^%ZTLOAD
+18 ;
+19 ;drops out of DO block on failure
Begin DoDot:1
+20 ;Undefined task
if ZTSK(0)=0
QUIT
+21 ;Active: Pending
if ZTSK(1)=1
QUIT
+22 ;Active: Running
if ZTSK(1)=2
QUIT
+23 ;Inactive: Available
if ZTSK(1)=4
QUIT
+24 ;Inactive: Interrupted
if ZTSK(1)=5
QUIT
+25 SET RESULT=1
End DoDot:1
+26 QUIT RESULT
