PRCTDELA ;MNTFW/RGB - STOP TASKED OPTION PRCHLO CLO PROCUREMENT;02/18/16
;;5.1;IFCAP;**194**;Feb 09, 1996;Build 3
;CLRS FTP server has been shut down. The system will now utilize the
;CDW to gather the data obtained from the GIP job and it extracts
;the Procurement portion
;
Q
EN ; Entry Point
;
D DELETE
D BMES^XPDUTL("Task option removal completed")
Q
;
;
DELETE ;Delete Task
N PRCHTSK,PRCHOPT,DA,DIK
S PRCHTSK="PRCHLO CLO PROCUREMENT"
S PRCHOPT=$O(^DIC(19,"B",PRCHTSK,"")) Q:'PRCHOPT
S DA="" S:'$G(DT) DT=$$DT^XLFDT
F S DA=$O(^DIC(19.2,"B",PRCHOPT,DA)) Q:'+DA D
. S ^XTMP("PRCHTSKA",$J,0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^copy of PRCHLO CLO PROCUREMENT Task^"_DA
. M ^XTMP("PRCHTSKA",$J,"DIC",19.2,DA)=^DIC(19.2,DA)
. S DIK="^DIC(19.2," D ^DIK
. D BMES^XPDUTL("Legacy task "_PRCHTSK_" Deleted.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCTDELA 854 printed Oct 16, 2024@18:20 Page 2
PRCTDELA ;MNTFW/RGB - STOP TASKED OPTION PRCHLO CLO PROCUREMENT;02/18/16
+1 ;;5.1;IFCAP;**194**;Feb 09, 1996;Build 3
+2 ;CLRS FTP server has been shut down. The system will now utilize the
+3 ;CDW to gather the data obtained from the GIP job and it extracts
+4 ;the Procurement portion
+5 ;
+6 QUIT
EN ; Entry Point
+1 ;
+2 DO DELETE
+3 DO BMES^XPDUTL("Task option removal completed")
+4 QUIT
+5 ;
+6 ;
DELETE ;Delete Task
+1 NEW PRCHTSK,PRCHOPT,DA,DIK
+2 SET PRCHTSK="PRCHLO CLO PROCUREMENT"
+3 SET PRCHOPT=$ORDER(^DIC(19,"B",PRCHTSK,""))
if 'PRCHOPT
QUIT
+4 SET DA=""
if '$GET(DT)
SET DT=$$DT^XLFDT
+5 FOR
SET DA=$ORDER(^DIC(19.2,"B",PRCHOPT,DA))
if '+DA
QUIT
Begin DoDot:1
+6 SET ^XTMP("PRCHTSKA",$JOB,0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^copy of PRCHLO CLO PROCUREMENT Task^"_DA
+7 MERGE ^XTMP("PRCHTSKA",$JOB,"DIC",19.2,DA)=^DIC(19.2,DA)
+8 SET DIK="^DIC(19.2,"
DO ^DIK
+9 DO BMES^XPDUTL("Legacy task "_PRCHTSK_" Deleted.")
End DoDot:1
+10 QUIT
+11 ;
