PRSXP83 ;WCIOFO/MGD-DELETE PP 03-06 ;04/16/2003
;;4.0;PAID;**83**;Sep 21, 1995
;
Q
;
; This program will delete PP 03-06 from the PAID PAYRUN DATA (#459)
; file so that Central PAID can re-send the corrected download.
; A message will be sent to Pam McClaran and Matt Dill to help with
; the tracking of which sites have installed the patch and have deleted
; PP 03-06.
;
; For more details see the patch description on FORUM.
;
START ; Main Driver
;
K ^TMP($J),TMP
N DA,DIK,MESS1,STANUM,TIME,TMP,U,XMSUB
S U="^",DA=0
D NOW^%DTC
S Y=%
D DD^%DT
S TIME=Y
W !!,"Post install routine PRSXP83 beginning at ",TIME_"."
;
; Get Station Number
;
S STANUM=$$KSP^XUPARAM("INST")_","
S STANUM=$$GET1^DIQ(4,STANUM,99)
S MESS1="Station: "_STANUM_" - "
;
S DA=$O(^PRST(459,"B","03-06",DA))
;
; Check to see if the entry does not exist
;
I DA'>0 D
. S ^TMP($J,"MGD",1)=MESS1_"PP 03-06 Not Found."
. W !!,MESS1_"PP 03-06 Not Found."
. W !,"Please contact NVS at 888-596-4357."
. S XMSUB="STATION "_STANUM_" PP 03-06 Not Found."
;
; Check to see if the entry does exist and delete it
;
I DA>0 D
. I '$D(^PRST(459,DA,0)) D
. . S ^TMP($J,"MGD",1)=MESS1_"PP 03-06 Not Found."
. . W !!,MESS1_"PP 03-06 Not Found."
. . W !,"Please contact NVS at 888-596-4357."
. . S XMSUB="STATION "_STANUM_" PP 03-06 Not Found."
. I $D(^PRST(459,DA,0)) D
. . S DIK="^PRST(459,"
. . D ^DIK
. . S ^TMP($J,"MGD",1)=MESS1_"PP 03-06 Deleted at "_TIME_"."
. . W !!,MESS1_"PP 03-06 Deleted at "_TIME_"."
. . S XMSUB="STATION "_STANUM_" PP 03-06 Deleted at "_TIME_"."
;
XMT ; Send status via mail message
;
I $D(^TMP($J,"MGD")) D
. N DIFROM,XMDUZ,XMTEXT,XMY
. S XMDUZ=.5
. S XMTEXT="^TMP($J,""MGD"","
. S XMY("MATT.DILL@DOMAIN.EXT")="",XMY(DUZ)=""
. S XMY("DILL.MATT@DOMAIN.EXT")=""
. S XMY("PAM.MCCLARAN@DOMAIN.EXT")=""
. S XMY("MCCLARAN.PAM@DOMAIN.EXT")=""
. D ^XMD
;
K ^TMP($J),Y,%
W !!,"Post install routine PRSXP83 completed.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSXP83 2028 printed Dec 13, 2024@02:29:03 Page 2
PRSXP83 ;WCIOFO/MGD-DELETE PP 03-06 ;04/16/2003
+1 ;;4.0;PAID;**83**;Sep 21, 1995
+2 ;
+3 QUIT
+4 ;
+5 ; This program will delete PP 03-06 from the PAID PAYRUN DATA (#459)
+6 ; file so that Central PAID can re-send the corrected download.
+7 ; A message will be sent to Pam McClaran and Matt Dill to help with
+8 ; the tracking of which sites have installed the patch and have deleted
+9 ; PP 03-06.
+10 ;
+11 ; For more details see the patch description on FORUM.
+12 ;
START ; Main Driver
+1 ;
+2 KILL ^TMP($JOB),TMP
+3 NEW DA,DIK,MESS1,STANUM,TIME,TMP,U,XMSUB
+4 SET U="^"
SET DA=0
+5 DO NOW^%DTC
+6 SET Y=%
+7 DO DD^%DT
+8 SET TIME=Y
+9 WRITE !!,"Post install routine PRSXP83 beginning at ",TIME_"."
+10 ;
+11 ; Get Station Number
+12 ;
+13 SET STANUM=$$KSP^XUPARAM("INST")_","
+14 SET STANUM=$$GET1^DIQ(4,STANUM,99)
+15 SET MESS1="Station: "_STANUM_" - "
+16 ;
+17 SET DA=$ORDER(^PRST(459,"B","03-06",DA))
+18 ;
+19 ; Check to see if the entry does not exist
+20 ;
+21 IF DA'>0
Begin DoDot:1
+22 SET ^TMP($JOB,"MGD",1)=MESS1_"PP 03-06 Not Found."
+23 WRITE !!,MESS1_"PP 03-06 Not Found."
+24 WRITE !,"Please contact NVS at 888-596-4357."
+25 SET XMSUB="STATION "_STANUM_" PP 03-06 Not Found."
End DoDot:1
+26 ;
+27 ; Check to see if the entry does exist and delete it
+28 ;
+29 IF DA>0
Begin DoDot:1
+30 IF '$DATA(^PRST(459,DA,0))
Begin DoDot:2
+31 SET ^TMP($JOB,"MGD",1)=MESS1_"PP 03-06 Not Found."
+32 WRITE !!,MESS1_"PP 03-06 Not Found."
+33 WRITE !,"Please contact NVS at 888-596-4357."
+34 SET XMSUB="STATION "_STANUM_" PP 03-06 Not Found."
End DoDot:2
+35 IF $DATA(^PRST(459,DA,0))
Begin DoDot:2
+36 SET DIK="^PRST(459,"
+37 DO ^DIK
+38 SET ^TMP($JOB,"MGD",1)=MESS1_"PP 03-06 Deleted at "_TIME_"."
+39 WRITE !!,MESS1_"PP 03-06 Deleted at "_TIME_"."
+40 SET XMSUB="STATION "_STANUM_" PP 03-06 Deleted at "_TIME_"."
End DoDot:2
End DoDot:1
+41 ;
XMT ; Send status via mail message
+1 ;
+2 IF $DATA(^TMP($JOB,"MGD"))
Begin DoDot:1
+3 NEW DIFROM,XMDUZ,XMTEXT,XMY
+4 SET XMDUZ=.5
+5 SET XMTEXT="^TMP($J,""MGD"","
+6 SET XMY("MATT.DILL@DOMAIN.EXT")=""
SET XMY(DUZ)=""
+7 SET XMY("DILL.MATT@DOMAIN.EXT")=""
+8 SET XMY("PAM.MCCLARAN@DOMAIN.EXT")=""
+9 SET XMY("MCCLARAN.PAM@DOMAIN.EXT")=""
+10 DO ^XMD
End DoDot:1
+11 ;
+12 KILL ^TMP($JOB),Y,%
+13 WRITE !!,"Post install routine PRSXP83 completed.",!
+14 QUIT