source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XU8P481.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1XU8P481 ;OAK_BP/BEE - NPI EXTRACT REPORT INTERFACE ROUTINE ;01-OCT-06
2 ;;8.0;KERNEL;**481**;Jul 10, 1995;Build 21
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; XUS*8.0*481 Post Processing Routine
6 ;
7 ; This routine will loop through the list of scheduled tasks and delete
8 ; any (TaskMan) scheduled runs of the XUS NPI CROSSWALK EXTRACT REPORT option.
9 ;
10 ; Routine has been adapted from the Delete Task Routine XUTMD
11 ;
12 ; Process completion MailMan message will be sent to DUZ of user
13 ; (or POSTMASTER if blank)
14 ;
15EN ; Entry Point - Called as a post processing routine from XU*8.0*481
16 N MSG,TASK,XUTMT,XUTMUCI,Y
17 ;
18 ;Retrieve Task Information
19 X ^%ZOSF("UCI") S XUTMUCI=Y
20 ;
21 ;Loop through list of tasks
22 S TASK=0
23 F S TASK=$O(^%ZTSK(TASK)) Q:'TASK D
24 .;
25 .;Get patch information
26 .N ZTSK S XUTMT=TASK,XUTMT(0)="R3" D ^XUTMT
27 .;
28 .;Only review Extract Related Tasks
29 .I $G(ZTSK(0))["XUS NPI EXTRACT" D
30 ..;
31 ..;Determine Task Status (Adapted from XUTMD)
32 ..I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="" Q ;Task is not defined
33 ..I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" Q ;Task is running and has no record
34 ..I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED" Q ;Task is scheduled but has no record
35 ..I $D(ZTSK(.11))#2,$O(ZTSK(.3))="" Q ;Task's record is incomplete
36 ..I $D(ZTSK(.11))#2,$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" Q ;Task is running and has an incomplete record
37 ..I $D(ZTSK(.11))#2 Q ;Task is scheduled, but has an incomplete record
38 ..I $O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" Q ;Task is running
39 ..;
40 ..;Delete Task (Adapted from XUTMD)
41 ..I $D(ZTSK(0))#2,ZTSK(0)["ZTSK^XQ1",$P(ZTSK(0),U,11)_","_$P(ZTSK(0),U,12)=XUTMUCI,$P(ZTSK(0),U,8)]"" D
42 ...N TSK S TSK=0 F S TSK=$O(^DIC(19.2,TSK)) Q:TSK'>0 I $G(^DIC(19.2,TSK,1))=TASK D
43 ....N DA,DIE,DR S DA=TSK,DIE="^DIC(19.2,",DR=".01///@" D ^DIE
44 ..;
45 ..;Remove entry in %ZTSCH
46 ..S XUTMT=TASK,XUTMT(0)="D" D ^XUTMT
47 ..;
48 ..;Log task number for MailMan message
49 ..S MSG=$G(MSG)+1,MSG(MSG)=TASK
50 ;
51 ;Run the extract as part of the installation process
52 D TASKMAN^XUSNPIX1
53 ;
54 ;Send completion message
55 D MSG(.MSG)
56 ;
57 ; Exit the process
58 ;
59EXIT K MSG,TASK,XUTMT,XUTMUCI,Y
60 Q
61 ;
62 ;Send MailMan Status Message
63 ;
64MSG(MSG) N XMSUB,XMTEXT,XMY,XMDUZ,DIFROM,XMZ,XMMG
65 ;
66 ;Set subject and text
67 S XMTEXT="MSG("
68 S XMSUB="Patch XU*8.0*481 post processing completed successfully"
69 S XMDUZ="KERNEL XU*8.0*481 PATCH INSTALLATION"
70 ;
71 ;Put subject in body as well so message will transmit
72 I $O(MSG(""))="" S MSG(.0001)="No XUS NPI Crosswalk Extract scheduled tasks were deleted"
73 E S MSG(.0001)="The following scheduled XUS NPI Crosswalk Extract tasks were deleted: "
74 ;
75 ;Set recipient - Default to POSTMASTER if no DUZ
76 I $G(DUZ)]"" S XMY(DUZ)=""
77 E S XMY(.5)=""
78 ;
79 ;Send
80 D ^XMD
81 ;
82 Q
Note: See TracBrowser for help on using the repository browser.