XU8P481 ;OAK_BP/BEE - NPI EXTRACT REPORT INTERFACE ROUTINE ;01-OCT-06
;;8.0;KERNEL;**481**;Jul 10, 1995;Build 18
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; XUS*8.0*481 Post Processing Routine
;
; This routine will loop through the list of scheduled tasks and delete
; any (TaskMan) scheduled runs of the XUS NPI CROSSWALK EXTRACT REPORT option.
;
; Routine has been adapted from the Delete Task Routine XUTMD
;
; Process completion MailMan message will be sent to DUZ of user
; (or POSTMASTER if blank)
;
EN ; Entry Point - Called as a post processing routine from XU*8.0*481
N MSG,TASK,XUTMT,XUTMUCI,Y
;
;Retrieve Task Information
X ^%ZOSF("UCI") S XUTMUCI=Y
;
;Loop through list of tasks
S TASK=0
F S TASK=$O(^%ZTSK(TASK)) Q:'TASK D
.;
.;Get patch information
.N ZTSK S XUTMT=TASK,XUTMT(0)="R3" D ^XUTMT
.;
.;Only review Extract Related Tasks
.I $G(ZTSK(0))["XUS NPI EXTRACT" D
..;
..;Determine Task Status (Adapted from XUTMD)
..I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="" Q ;Task is not defined
..I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" Q ;Task is running and has no record
..I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED" Q ;Task is scheduled but has no record
..I $D(ZTSK(.11))#2,$O(ZTSK(.3))="" Q ;Task's record is incomplete
..I $D(ZTSK(.11))#2,$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" Q ;Task is running and has an incomplete record
..I $D(ZTSK(.11))#2 Q ;Task is scheduled, but has an incomplete record
..I $O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" Q ;Task is running
..;
..;Delete Task (Adapted from XUTMD)
..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
...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
....N DA,DIE,DR S DA=TSK,DIE="^DIC(19.2,",DR=".01///@" D ^DIE
..;
..;Remove entry in %ZTSCH
..S XUTMT=TASK,XUTMT(0)="D" D ^XUTMT
..;
..;Log task number for MailMan message
..S MSG=$G(MSG)+1,MSG(MSG)=TASK
;
;Run the extract as part of the installation process
D TASKMAN^XUSNPIX1
;
;Send completion message
D MSG(.MSG)
;
; Exit the process
;
EXIT K MSG,TASK,XUTMT,XUTMUCI,Y
Q
;
;Send MailMan Status Message
;
MSG(MSG) N XMSUB,XMTEXT,XMY,XMDUZ,DIFROM,XMZ,XMMG
;
;Set subject and text
S XMTEXT="MSG("
S XMSUB="Patch XU*8.0*481 post processing completed successfully"
S XMDUZ="KERNEL XU*8.0*481 PATCH INSTALLATION"
;
;Put subject in body as well so message will transmit
I $O(MSG(""))="" S MSG(.0001)="No XUS NPI Crosswalk Extract scheduled tasks were deleted"
E S MSG(.0001)="The following scheduled XUS NPI Crosswalk Extract tasks were deleted: "
;
;Set recipient - Default to POSTMASTER if no DUZ
I $G(DUZ)]"" S XMY(DUZ)=""
E S XMY(.5)=""
;
;Send
D ^XMD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P481 2908 printed Nov 22, 2024@17:18:01 Page 2
XU8P481 ;OAK_BP/BEE - NPI EXTRACT REPORT INTERFACE ROUTINE ;01-OCT-06
+1 ;;8.0;KERNEL;**481**;Jul 10, 1995;Build 18
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; XUS*8.0*481 Post Processing Routine
+5 ;
+6 ; This routine will loop through the list of scheduled tasks and delete
+7 ; any (TaskMan) scheduled runs of the XUS NPI CROSSWALK EXTRACT REPORT option.
+8 ;
+9 ; Routine has been adapted from the Delete Task Routine XUTMD
+10 ;
+11 ; Process completion MailMan message will be sent to DUZ of user
+12 ; (or POSTMASTER if blank)
+13 ;
EN ; Entry Point - Called as a post processing routine from XU*8.0*481
+1 NEW MSG,TASK,XUTMT,XUTMUCI,Y
+2 ;
+3 ;Retrieve Task Information
+4 XECUTE ^%ZOSF("UCI")
SET XUTMUCI=Y
+5 ;
+6 ;Loop through list of tasks
+7 SET TASK=0
+8 FOR
SET TASK=$ORDER(^%ZTSK(TASK))
if 'TASK
QUIT
Begin DoDot:1
+9 ;
+10 ;Get patch information
+11 NEW ZTSK
SET XUTMT=TASK
SET XUTMT(0)="R3"
DO ^XUTMT
+12 ;
+13 ;Only review Extract Related Tasks
+14 IF $GET(ZTSK(0))["XUS NPI EXTRACT"
Begin DoDot:2
+15 ;
+16 ;Determine Task Status (Adapted from XUTMD)
+17 ;Task is not defined
IF $DATA(ZTSK(.11))#2
IF ZTSK(.11)="UNDEFINED"
IF $ORDER(ZTSK(.3))=""
QUIT
+18 ;Task is running and has no record
IF $DATA(ZTSK(.11))#2
IF ZTSK(.11)="UNDEFINED"
IF $ORDER(ZTSK(.3))="TASK"
IF $ORDER(ZTSK("TASK"))=""
QUIT
+19 ;Task is scheduled but has no record
IF $DATA(ZTSK(.11))#2
IF ZTSK(.11)="UNDEFINED"
QUIT
+20 ;Task's record is incomplete
IF $DATA(ZTSK(.11))#2
IF $ORDER(ZTSK(.3))=""
QUIT
+21 ;Task is running and has an incomplete record
IF $DATA(ZTSK(.11))#2
IF $ORDER(ZTSK(.3))="TASK"
IF $ORDER(ZTSK("TASK"))=""
QUIT
+22 ;Task is scheduled, but has an incomplete record
IF $DATA(ZTSK(.11))#2
QUIT
+23 ;Task is running
IF $ORDER(ZTSK(.3))="TASK"
IF $ORDER(ZTSK("TASK"))=""
QUIT
+24 ;
+25 ;Delete Task (Adapted from XUTMD)
+26 IF $DATA(ZTSK(0))#2
IF ZTSK(0)["ZTSK^XQ1"
IF $PIECE(ZTSK(0),U,11)_","_$PIECE(ZTSK(0),U,12)=XUTMUCI
IF $PIECE(ZTSK(0),U,8)]""
Begin DoDot:3
+27 NEW TSK
SET TSK=0
FOR
SET TSK=$ORDER(^DIC(19.2,TSK))
if TSK'>0
QUIT
IF $GET(^DIC(19.2,TSK,1))=TASK
Begin DoDot:4
+28 NEW DA,DIE,DR
SET DA=TSK
SET DIE="^DIC(19.2,"
SET DR=".01///@"
DO ^DIE
End DoDot:4
End DoDot:3
+29 ;
+30 ;Remove entry in %ZTSCH
+31 SET XUTMT=TASK
SET XUTMT(0)="D"
DO ^XUTMT
+32 ;
+33 ;Log task number for MailMan message
+34 SET MSG=$GET(MSG)+1
SET MSG(MSG)=TASK
End DoDot:2
End DoDot:1
+35 ;
+36 ;Run the extract as part of the installation process
+37 DO TASKMAN^XUSNPIX1
+38 ;
+39 ;Send completion message
+40 DO MSG(.MSG)
+41 ;
+42 ; Exit the process
+43 ;
EXIT KILL MSG,TASK,XUTMT,XUTMUCI,Y
+1 QUIT
+2 ;
+3 ;Send MailMan Status Message
+4 ;
MSG(MSG) NEW XMSUB,XMTEXT,XMY,XMDUZ,DIFROM,XMZ,XMMG
+1 ;
+2 ;Set subject and text
+3 SET XMTEXT="MSG("
+4 SET XMSUB="Patch XU*8.0*481 post processing completed successfully"
+5 SET XMDUZ="KERNEL XU*8.0*481 PATCH INSTALLATION"
+6 ;
+7 ;Put subject in body as well so message will transmit
+8 IF $ORDER(MSG(""))=""
SET MSG(.0001)="No XUS NPI Crosswalk Extract scheduled tasks were deleted"
+9 IF '$TEST
SET MSG(.0001)="The following scheduled XUS NPI Crosswalk Extract tasks were deleted: "
+10 ;
+11 ;Set recipient - Default to POSTMASTER if no DUZ
+12 IF $GET(DUZ)]""
SET XMY(DUZ)=""
+13 IF '$TEST
SET XMY(.5)=""
+14 ;
+15 ;Send
+16 DO ^XMD
+17 ;
+18 QUIT
