- 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 Mar 13, 2025@21:24:04 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 ;
