PRCTDELA.m

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 ---PRCTDELA   854     printed  Apr 09, 2024@21:16:33                                                                                                                                                                                                     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      ;