SCMCHL7K ;ALB/DJS - STOP PCMM HL7 TRANSMISSIONS;08/18/14
;;5.3;Scheduling;**624**;AUG 13, 1993;Build 19
;
; #1157 [Supported] Kernel XPDMENU call
; #2051 - Database Server API: Lookup Utilities (DIC)
; #6121 - Remove Task from #19.2
; SCOPT - Menu option to mark out-of-order
; SCTXT - Out-of-order message text
; PLAN - Turn off Logical Links, empty HL7 event file and HL7 error file,
; set all HL7 related options Out-Of-Order, set all HL7 Protocols
; Out-Of-Order.
Q
EN ; Entry Point
;
D LOGLNK,EMFILE,OPTOUT,DELETE
D BMES^XPDUTL("Patch Completed")
Q
;
LOGLNK ; This Routine will turn off Logical Links for PCMM.
N SCMCL,SCMCVAL,DA,DR
S SCMCL="1" F S SCMCL=$O(^HLCS(870,SCMCL)) Q:SCMCL'>0 D
. I $P(^HLCS(870,SCMCL,0),U,1)="PCMM" D
.. N DIE S DIE="^HLCS(870,",DA=SCMCL,DR="4.5///0;14///1" D ^DIE
.. D BMES^XPDUTL("Logical Links for PCMM HL7 have been shut down and Autostart disabled.")
Q
;
EMFILE ;Empty HL7 Event File and Error File
;
N SCMCN,SCMCL,SCMCVAL,SCMCZ,SCFN,DA
F SCMCN=1:1 S SCFN=$P($TEXT(FILELIST+SCMCN),";;",2) Q:SCFN="$$END"!(SCFN="") D
. S ^XTMP("SD",$J,0)=$$FMADD^XLFDT(DT+90)_"^"_DT_"^copy of SCPT global deleted"
. M ^XTMP("SD",$J,"SCPT",SCFN)=^SCPT(SCFN)
. K ^SCPT(SCFN)
. S ^SCPT(SCFN,0)=^XTMP("SD",$J,"SCPT",SCFN,0)
. S SCMCZ=$P(^SCPT(SCFN,0),U,1,2)_"^0^0"
. S ^SCPT(SCFN,0)=SCMCZ
D BMES^XPDUTL("All PCMM HL7 related data files have been deleted.")
Q
;
OPTOUT ;Set option out-of-order
N SCMCN,SCOPT,SCTXT
S SCTXT="This functionality is now accomplished by CDW/VSSC."
F SCMCN=1:1 S SCOPT=$P($TEXT(OPTLIST+SCMCN),";;",2) Q:SCOPT="$$END"!(SCOPT="") D
. D OUT^XPDMENU(SCOPT,SCTXT) ;Mark option out-of-order
D BMES^XPDUTL("Legacy PCMM options were marked Out-of-Order.")
Q
;
DELETE ;Delete Task
N SCTSK,SCOPT,DA,DIK
S SCTSK="SCMC PCMM HL7 TRANSMIT"
S SCOPT=$O(^DIC(19,"B",SCTSK,""))
S DA=""
F S DA=$O(^DIC(19.2,"B",SCOPT,DA)) Q:'+DA D
. S ^XTMP("SCTSK",$J,0)=$$FMADD^XLFDT(DT+90)_"^"_DT_"^copy of PCMM HL7 Task^"_DA
. M ^XTMP("SCTSK",$J,"DIC",19.2,DA)=^DIC(19.2,DA)
. S DIK="^DIC(19.2," D ^DIK
. D BMES^XPDUTL("Legacy task "_SCTSK_" Deleted.")
Q
;
OPTLIST ;OPTIONS LIST
;;SCMC HL7 MENU
;;SCMC PCMM ERR CODE REPORT
;;SCMC PCMM HL7 TRANSMIT
;;SCMC PCMM REJECT TRANS MENU
;;SCMC PCMM TRANS ERROR PROC
;;SCMC PCMM TRANS ERROR REPORT
;;$$END
;
FILELIST ;LIST OF FILES TO EMPTY
;;404.471
;;404.48
;;404.49
;;$$END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCHL7K 2487 printed Dec 13, 2024@02:40:21 Page 2
SCMCHL7K ;ALB/DJS - STOP PCMM HL7 TRANSMISSIONS;08/18/14
+1 ;;5.3;Scheduling;**624**;AUG 13, 1993;Build 19
+2 ;
+3 ; #1157 [Supported] Kernel XPDMENU call
+4 ; #2051 - Database Server API: Lookup Utilities (DIC)
+5 ; #6121 - Remove Task from #19.2
+6 ; SCOPT - Menu option to mark out-of-order
+7 ; SCTXT - Out-of-order message text
+8 ; PLAN - Turn off Logical Links, empty HL7 event file and HL7 error file,
+9 ; set all HL7 related options Out-Of-Order, set all HL7 Protocols
+10 ; Out-Of-Order.
+11 QUIT
EN ; Entry Point
+1 ;
+2 DO LOGLNK
DO EMFILE
DO OPTOUT
DO DELETE
+3 DO BMES^XPDUTL("Patch Completed")
+4 QUIT
+5 ;
LOGLNK ; This Routine will turn off Logical Links for PCMM.
+1 NEW SCMCL,SCMCVAL,DA,DR
+2 SET SCMCL="1"
FOR
SET SCMCL=$ORDER(^HLCS(870,SCMCL))
if SCMCL'>0
QUIT
Begin DoDot:1
+3 IF $PIECE(^HLCS(870,SCMCL,0),U,1)="PCMM"
Begin DoDot:2
+4 NEW DIE
SET DIE="^HLCS(870,"
SET DA=SCMCL
SET DR="4.5///0;14///1"
DO ^DIE
+5 DO BMES^XPDUTL("Logical Links for PCMM HL7 have been shut down and Autostart disabled.")
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
EMFILE ;Empty HL7 Event File and Error File
+1 ;
+2 NEW SCMCN,SCMCL,SCMCVAL,SCMCZ,SCFN,DA
+3 FOR SCMCN=1:1
SET SCFN=$PIECE($TEXT(FILELIST+SCMCN),";;",2)
if SCFN="$$END"!(SCFN="")
QUIT
Begin DoDot:1
+4 SET ^XTMP("SD",$JOB,0)=$$FMADD^XLFDT(DT+90)_"^"_DT_"^copy of SCPT global deleted"
+5 MERGE ^XTMP("SD",$JOB,"SCPT",SCFN)=^SCPT(SCFN)
+6 KILL ^SCPT(SCFN)
+7 SET ^SCPT(SCFN,0)=^XTMP("SD",$JOB,"SCPT",SCFN,0)
+8 SET SCMCZ=$PIECE(^SCPT(SCFN,0),U,1,2)_"^0^0"
+9 SET ^SCPT(SCFN,0)=SCMCZ
End DoDot:1
+10 DO BMES^XPDUTL("All PCMM HL7 related data files have been deleted.")
+11 QUIT
+12 ;
OPTOUT ;Set option out-of-order
+1 NEW SCMCN,SCOPT,SCTXT
+2 SET SCTXT="This functionality is now accomplished by CDW/VSSC."
+3 FOR SCMCN=1:1
SET SCOPT=$PIECE($TEXT(OPTLIST+SCMCN),";;",2)
if SCOPT="$$END"!(SCOPT="")
QUIT
Begin DoDot:1
+4 ;Mark option out-of-order
DO OUT^XPDMENU(SCOPT,SCTXT)
End DoDot:1
+5 DO BMES^XPDUTL("Legacy PCMM options were marked Out-of-Order.")
+6 QUIT
+7 ;
DELETE ;Delete Task
+1 NEW SCTSK,SCOPT,DA,DIK
+2 SET SCTSK="SCMC PCMM HL7 TRANSMIT"
+3 SET SCOPT=$ORDER(^DIC(19,"B",SCTSK,""))
+4 SET DA=""
+5 FOR
SET DA=$ORDER(^DIC(19.2,"B",SCOPT,DA))
if '+DA
QUIT
Begin DoDot:1
+6 SET ^XTMP("SCTSK",$JOB,0)=$$FMADD^XLFDT(DT+90)_"^"_DT_"^copy of PCMM HL7 Task^"_DA
+7 MERGE ^XTMP("SCTSK",$JOB,"DIC",19.2,DA)=^DIC(19.2,DA)
+8 SET DIK="^DIC(19.2,"
DO ^DIK
+9 DO BMES^XPDUTL("Legacy task "_SCTSK_" Deleted.")
End DoDot:1
+10 QUIT
+11 ;
OPTLIST ;OPTIONS LIST
+1 ;;SCMC HL7 MENU
+2 ;;SCMC PCMM ERR CODE REPORT
+3 ;;SCMC PCMM HL7 TRANSMIT
+4 ;;SCMC PCMM REJECT TRANS MENU
+5 ;;SCMC PCMM TRANS ERROR PROC
+6 ;;SCMC PCMM TRANS ERROR REPORT
+7 ;;$$END
+8 ;
FILELIST ;LIST OF FILES TO EMPTY
+1 ;;404.471
+2 ;;404.48
+3 ;;404.49
+4 ;;$$END
