PSXDODNT ;CMC/WPB Utility to watch DoD directories ;04/01/02 16:52:42
;;2.0;CMOP;**38,45**;11 Apr 97
;this routine will watch the incoming directories for files from DoD
;facilities and direct processing to the appropriate routine.
;
;create an option to call the routine, then schedule the option to run
;every 15 minutes using the TaskMan scheduler
;
;files extensions:
; .trn - transmission of dispense request from Outside Agency to VistA
; .ack - acknowledgement of dispense requests from VistA to Outside Agency
; .qry - prescription fulfillment data from VistA to Outside Agency
; .qac - acknowledgement of receipt of fulfillment data from Outside Agency to VistA
; .sit - activation/deactivation from Outside Agency to VistA
; .sac - acknowledgement of activation/deactivation message from VistA to Outside Agency
; .sch - auto transmission schedule/unscheduled message from Outside Agency to VistA
; .hac - acknowledgement of auto transmission schedule/unscheduled message from VistA to Outside Agency
;
;the path must be setup before this routine can run:
; path = \\SERVERNAME\CMOP\INBOX
;for testing the servername = vhacmcdhc3
;
; VARIABLES
; FILELIST the type of files to look for. this is set to all files in the directory
; FILE stores the list of files
; PATH the path to the directory where the files are stored
;
EN ;reads the directory for files
K FILELIST,FILE,PSXERCNT
; test if previous job still running
S PREVJOB=$O(^XTMP("PSXDODNT")),PSXJOB="PSXDODNT-"_$J
I PREVJOB'="",PREVJOB["PSXDODNT-",PREVJOB'=PSXJOB D I PSXQUIT W !,"STOPPING" Q
. S PSXQUIT=1
. D NOW^%DTC S X1=%,X2=^XTMP(PREVJOB,1) S DIF=$$FMDIFF^XLFDT(X1,X2,2)
. I DIF<1200 Q ; if less than 20 minutes quit
. ;if > 20 minutes, store off previous trail and start new
. D NOW^%DTC
. M ^XTMP("PSXDODERR",%,PREVJOB)=^XTMP(PREVJOB) K ^XTMP(PREVJOB)
. S X=$$FMADD^XLFDT(DT,3) S ^XTMP("PSXDODERR",0)=X_U_DT_U_"DOD CMOP PROCESS ERROR CAPTURE"
. K ^XTMP(PREVJOB) S PSXQUIT=0
. D NOW^%DTC S XX=$$FMTE^XLFDT(%)
. S XMSUB="DOD CMOP INTERFACE STOPPED IRREGULARLY "_XX,XMTEXT="TXT("
. K TXT
. S TXT(1,0)="The DOD CMOP Interface has been idle more than 20 minutes "_XX
. S TXT(2,0)="The XTMP audit trail has been stored in ^XTMP(""PSXDODERR"","_%
. S TXT(3,0)="If this message is appearing frequently contact your CMOP IRM support"
. D ^XMD
; proceeding to process files
D RESEND
S X1=DT,X2=1 D C^%DTC S PSXDT=X
D NOW^%DTC
K ^XTMP(PSXJOB)
S ^XTMP(PSXJOB,0)=PSXDT_U_%_U_"DOD PSXDODNT LOGGER"
S ^XTMP(PSXJOB,1)=%
;S FILELIST("*.*")=""
F EXT="*.trn","*.sit","*.sch","*.qac" S FILELIST(EXT)="" ;****testing
; SET PATH=INBOX DIRECTORY PATH
S PATH=$$GET1^DIQ(554,1,20),FILE=""
S Y=$$LIST^%ZISH(PATH,"FILELIST","FILE")
I Y'=1 D Q ;if Y doesn't equal 1 there weren't any files to get, the routine will stop until called by TaskMan
. D KVAR
. K ^XTMP(PSXJOB) ;****TESTING
;
DIRECT ;reads the FILE variable to see what types files are available for processing and then sends process to the appropriate routine
I $E(IOST)="C" W !,"Processing Files:" S FILENM="" F S FILENM=$O(FILE(FILENM)) Q:FILENM="" W !,?5,FILENM
S FILENM=""
; re-entry for next file if error encountered
;W !,"nxtfile3"
;F W !,"Nxtfile3a ",FILENM S FILENM=$O(FILE(FILENM)) W !,"nxtfile3b ",FILENM Q:FILENM="" D
F S FILENM=$O(FILE(FILENM)) Q:FILENM="" D
. I '$G(^XTMP("PSXNTSTOP-1",0)) N $ETRAP,$ESTACK S $ETRAP="D ZTER^PSXDODNT"
. S EXT=$$UP^XLFSTR($P(FILENM,".",2))
. ; the following line to be used with Vitria BusinessWare
. S ROU=$S(EXT["SIT":"ACT^PSXDODAC(PATH,FILENM)",EXT["SCH":"EN^PSXDODAT(PATH,FILENM)",EXT["TRN":"EN^PSXDODB(PATH,FILENM)",EXT["QAC":"EN^PSXDODAK(PATH,FILENM)",1:"")
. ;the following line to be used when Vitrai BusinessWare is not being used
. ;S ROU=$S(EXT["SIT":"ACT^PSXDODAC(PATH,FILENM)",EXT["SCH":"EN^PSXDODAT(PATH,FILENM)",EXT["TRN":"EN^PSXDODH(PATH,FILENM)",EXT["QAC":"EN^PSXDODAK(PATH,FILENM)",1:"")
. H 2 D NOW^%DTC S ^XTMP(PSXJOB,%)=FILENM,^XTMP(PSXJOB,1)=%,JOBBEG=% ;I $E(IOST)="C" W !,JOBBEG,?20,^XTMP(PSXJOB,JOBBEG)
. D ROU
. D FINISH
. H 2 D NOW^%DTC S $P(^XTMP(PSXJOB,JOBBEG),U,3)=%,^XTMP(PSXJOB,1)=% ;I $E(IOST)="C" W !,%,?20,^XTMP(PSXJOB,JOBBEG)
K I,INC,Y,ROU
D KVAR
G EN ;loop to see if any other files came in to pickup
;
FINISH ;
I $E(IOST)="C" W !,"nxtfile4 Finish of ",FILENM
K ^TMP($J,"PSXDODNT")
PULL S PATH=$$GET1^DIQ(554,1,20) S Y=$$FTG^%ZISH(PATH,FILENM,$NA(^TMP($J,"PSXDODNT",1)),3)
ARCHIVE ;
S FILENMAR=FILENM
I FILENM[".TRN" S FILENMAR=FILENM_".BW"
S PATH=$$GET1^DIQ(554,1,22) F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDODNT",1)),3,PATH,FILENMAR) Q:Y=1 H 4
I Y'=1 S GBL=$NA(^TMP($J,"PSXDODNT")) D FALERT(FILENMAR,PATH,GBL)
REMOVE I $L($G(FILENM)) K PSXL S PSXL(FILENM)="",PATH=$$GET1^DIQ(554,1,20),Y=$$DEL^%ZISH(PATH,"PSXL")
Q
KVAR ;K FILELIST,FILE,Y,PATH,BADFILE
Q
ROU ; nest the new command so variables will be protected
N FILE,JOBBEG,JOBEND,PSXJOB
I $E(IOST)="C" W !,FILENM," ",ROU
D @ROU
Q
ZTER ;Friendly RE-cycle error and move to next file
S XXERR=$$EC^%ZOSV
S XMSUB="DOD CMOP Error on File "_FILENM
S BADFILE=FILENM
S XMTEXT="TEXT("
S TEXT(1,0)="DOD CMOP encountered the following error. Please investigate"
S TEXT(2,0)="File: "_FILENM
S TEXT(3,0)="Error: "_XXERR
S TEXT(4,0)="The file has been moved into the Hold directory "_$$GET1^DIQ(554,1,23)
D GRP1^PSXNOTE
D ^%ZTER ;log error into Kernel K8SYS pg 183
D ^XMD
I $E(IOST)="C" W !,"zter2:Error Finish & Removal of ",FILENM
K ^TMP($J,"PSXDODNT"),TEXT
PULL2 S PATH=$$GET1^DIQ(554,1,20),Y=$$FTG^%ZISH(PATH,FILENM,$NA(^TMP($J,"PSXDODNT",1)),3)
HOLD S PATH=$$GET1^DIQ(554,1,23) F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDODNT",1)),3,PATH,FILENM) Q:Y=1 H 4
I Y'=1 S GBL=$NA(^TMP($J,"PSXDODNT")) D FALERT(FILENM,PATH,GBL)
ARCHIVE2 S PATH=$$GET1^DIQ(554,1,22) F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDODNT",1)),3,PATH,FILENM) Q:Y=1 H 4
I Y'=1 S GBL=$NA(^TMP($J,"PSXDODNT")) D FALERT(FILENM,PATH,GBL)
REMOVE2 K PSXL S PSXL(FILENM)="",PATH=$$GET1^DIQ(554,1,20),Y=$$DEL^%ZISH(PATH,"PSXL")
D NOW^%DTC S Y=% X ^DD("DD")
S XQAMSG="PLEASE INVESTIGATE - CMOP/DOD error "_XXERR_" "_Y,XQAID="PSXDODNT"
D GRP1^PSXNOTE M XQA=XMY D SETUP^XQALERT
H 10
G UNWIND^%ZTER ; return to code 1 level above where $ETRAP set ie the F Loop
Q
FALERT(FILE,PATH,GBL) ;fail to pass file into target directory, send alert, store for later
D NOW^%DTC S Y=% X ^DD("DD")
S XQAMSG="DOD: "_FILE_" failed placement into: "_PATH_" "_Y,XQAID="PSXDODNT"
D GRP1^PSXNOTE M XQA=XMY ;****TESTING
;S XQA(DUZ)="" ;****TESTING
D SETUP^XQALERT
STORE ; store file intO XTMP if GBL PROVIDED
Q:$G(GBL)=""
D NOW^%DTC S NMSPACE="PSXFILE"_"-"_%
S DTPRG=$$FMADD^XLFDT(DT,7) ; save for 7 days
K ^XTMP(NMSPACE)
S ^XTMP(NMSPACE,0)=DTPRG_U_DT_U_"DOD FILE TO SEND"
S ^XTMP(NMSPACE,1)=FILE,^XTMP(NMSPACE,2)=PATH
M ^XTMP(NMSPACE,"T")=@GBL ; GBL IN FORM OF S GBL=$NA(^TMP($J,"PSXDODNT"))
Q
RESEND ; SCAN XTMP and if entries put the files into the boxes
S NMSPACE="PSXFILE"
F S NMSPACE=$O(^XTMP(NMSPACE)) Q:$E(NMSPACE,1,7)'="PSXFILE" D
.S FILE=^XTMP(NMSPACE,1),PATH=^XTMP(NMSPACE,2)
.;W !,FILE," ",PATH
.S Y=$$GTF^%ZISH($NA(^XTMP(NMSPACE,"T",1)),3,PATH,FILE)
.I Y'=1 D FALERT("Resending DOD files ",PATH) S NMSPACE="XX" Q
.K ^XTMP(NMSPACE)
.D NOW^%DTC S Y=% X ^DD("DD")
.S XQAMSG="DOD: "_FILE_" DID PLACE into: "_PATH_" "_Y,XQAID="PSXDODNT"
.;W !,XQAMSG
.D GRP1^PSXNOTE M XQA=XMY ;****TESTING
.;S XQA(DUZ)="" ;****TESTING
.D SETUP^XQALERT
.Q
CLEAR ; CLEAR PREVIOUS NODES history nodes
S X="PSXDODNT" F S X=$O(^XTMP(X)) Q:X'["PSXDODNT" W !,X K ^XTMP(X)
Q
KILLERR ; kill the error LOG ^XTMP("PSXDODERR", )
K ^XTMP("PSXDODERR")
Q
START ;enable/start auto error trapping
K ^XTMP("PSXNTSTOP-1")
Q
STOP ;disable auto error trapping
S ^XTMP("PSXNTSTOP-1",0)=DT_U_DT_U_"disable PSXDODNT auto error trapping"
Q
EDIT ; edit the PSX DODNT option K8 SYS pg 342
D EDIT^XUTMOPT("PSX DOD CMOP INTERFACE")
Q
DISP ; display schedule
D DISP^XUTMOPT("PSX DOD CMOP INTERFACE")
Q
CLEARALL ; clear boxes out, archive, hold of all files
F XX=21,22,23 D CLEARFLS^PSXDODH(XX,"*.*")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXDODNT 8347 printed Apr 09, 2024@20:50:10 Page 2
PSXDODNT ;CMC/WPB Utility to watch DoD directories ;04/01/02 16:52:42
+1 ;;2.0;CMOP;**38,45**;11 Apr 97
+2 ;this routine will watch the incoming directories for files from DoD
+3 ;facilities and direct processing to the appropriate routine.
+4 ;
+5 ;create an option to call the routine, then schedule the option to run
+6 ;every 15 minutes using the TaskMan scheduler
+7 ;
+8 ;files extensions:
+9 ; .trn - transmission of dispense request from Outside Agency to VistA
+10 ; .ack - acknowledgement of dispense requests from VistA to Outside Agency
+11 ; .qry - prescription fulfillment data from VistA to Outside Agency
+12 ; .qac - acknowledgement of receipt of fulfillment data from Outside Agency to VistA
+13 ; .sit - activation/deactivation from Outside Agency to VistA
+14 ; .sac - acknowledgement of activation/deactivation message from VistA to Outside Agency
+15 ; .sch - auto transmission schedule/unscheduled message from Outside Agency to VistA
+16 ; .hac - acknowledgement of auto transmission schedule/unscheduled message from VistA to Outside Agency
+17 ;
+18 ;the path must be setup before this routine can run:
+19 ; path = \\SERVERNAME\CMOP\INBOX
+20 ;for testing the servername = vhacmcdhc3
+21 ;
+22 ; VARIABLES
+23 ; FILELIST the type of files to look for. this is set to all files in the directory
+24 ; FILE stores the list of files
+25 ; PATH the path to the directory where the files are stored
+26 ;
EN ;reads the directory for files
+1 KILL FILELIST,FILE,PSXERCNT
+2 ; test if previous job still running
+3 SET PREVJOB=$ORDER(^XTMP("PSXDODNT"))
SET PSXJOB="PSXDODNT-"_$JOB
+4 IF PREVJOB'=""
IF PREVJOB["PSXDODNT-"
IF PREVJOB'=PSXJOB
Begin DoDot:1
+5 SET PSXQUIT=1
+6 DO NOW^%DTC
SET X1=%
SET X2=^XTMP(PREVJOB,1)
SET DIF=$$FMDIFF^XLFDT(X1,X2,2)
+7 ; if less than 20 minutes quit
IF DIF<1200
QUIT
+8 ;if > 20 minutes, store off previous trail and start new
+9 DO NOW^%DTC
+10 MERGE ^XTMP("PSXDODERR",%,PREVJOB)=^XTMP(PREVJOB)
KILL ^XTMP(PREVJOB)
+11 SET X=$$FMADD^XLFDT(DT,3)
SET ^XTMP("PSXDODERR",0)=X_U_DT_U_"DOD CMOP PROCESS ERROR CAPTURE"
+12 KILL ^XTMP(PREVJOB)
SET PSXQUIT=0
+13 DO NOW^%DTC
SET XX=$$FMTE^XLFDT(%)
+14 SET XMSUB="DOD CMOP INTERFACE STOPPED IRREGULARLY "_XX
SET XMTEXT="TXT("
+15 KILL TXT
+16 SET TXT(1,0)="The DOD CMOP Interface has been idle more than 20 minutes "_XX
+17 SET TXT(2,0)="The XTMP audit trail has been stored in ^XTMP(""PSXDODERR"","_%
+18 SET TXT(3,0)="If this message is appearing frequently contact your CMOP IRM support"
+19 DO ^XMD
End DoDot:1
IF PSXQUIT
WRITE !,"STOPPING"
QUIT
+20 ; proceeding to process files
+21 DO RESEND
+22 SET X1=DT
SET X2=1
DO C^%DTC
SET PSXDT=X
+23 DO NOW^%DTC
+24 KILL ^XTMP(PSXJOB)
+25 SET ^XTMP(PSXJOB,0)=PSXDT_U_%_U_"DOD PSXDODNT LOGGER"
+26 SET ^XTMP(PSXJOB,1)=%
+27 ;S FILELIST("*.*")=""
+28 ;****testing
FOR EXT="*.trn","*.sit","*.sch","*.qac"
SET FILELIST(EXT)=""
+29 ; SET PATH=INBOX DIRECTORY PATH
+30 SET PATH=$$GET1^DIQ(554,1,20)
SET FILE=""
+31 SET Y=$$LIST^%ZISH(PATH,"FILELIST","FILE")
+32 ;if Y doesn't equal 1 there weren't any files to get, the routine will stop until called by TaskMan
IF Y'=1
Begin DoDot:1
+33 DO KVAR
+34 ;****TESTING
KILL ^XTMP(PSXJOB)
End DoDot:1
QUIT
+35 ;
DIRECT ;reads the FILE variable to see what types files are available for processing and then sends process to the appropriate routine
+1 IF $EXTRACT(IOST)="C"
WRITE !,"Processing Files:"
SET FILENM=""
FOR
SET FILENM=$ORDER(FILE(FILENM))
if FILENM=""
QUIT
WRITE !,?5,FILENM
+2 SET FILENM=""
+3 ; re-entry for next file if error encountered
+4 ;W !,"nxtfile3"
+5 ;F W !,"Nxtfile3a ",FILENM S FILENM=$O(FILE(FILENM)) W !,"nxtfile3b ",FILENM Q:FILENM="" D
+6 FOR
SET FILENM=$ORDER(FILE(FILENM))
if FILENM=""
QUIT
Begin DoDot:1
+7 IF '$GET(^XTMP("PSXNTSTOP-1",0))
NEW $ETRAP,$ESTACK
SET $ETRAP="D ZTER^PSXDODNT"
+8 SET EXT=$$UP^XLFSTR($PIECE(FILENM,".",2))
+9 ; the following line to be used with Vitria BusinessWare
+10 SET ROU=$SELECT(EXT["SIT":"ACT^PSXDODAC(PATH,FILENM)",EXT["SCH":"EN^PSXDODAT(PATH,FILENM)",EXT["TRN":"EN^PSXDODB(PATH,FILENM)",EXT["QAC":"EN^PSXDODAK(PATH,FILENM)",1:"")
+11 ;the following line to be used when Vitrai BusinessWare is not being used
+12 ;S ROU=$S(EXT["SIT":"ACT^PSXDODAC(PATH,FILENM)",EXT["SCH":"EN^PSXDODAT(PATH,FILENM)",EXT["TRN":"EN^PSXDODH(PATH,FILENM)",EXT["QAC":"EN^PSXDODAK(PATH,FILENM)",1:"")
+13 ;I $E(IOST)="C" W !,JOBBEG,?20,^XTMP(PSXJOB,JOBBEG)
HANG 2
DO NOW^%DTC
SET ^XTMP(PSXJOB,%)=FILENM
SET ^XTMP(PSXJOB,1)=%
SET JOBBEG=%
+14 DO ROU
+15 DO FINISH
+16 ;I $E(IOST)="C" W !,%,?20,^XTMP(PSXJOB,JOBBEG)
HANG 2
DO NOW^%DTC
SET $PIECE(^XTMP(PSXJOB,JOBBEG),U,3)=%
SET ^XTMP(PSXJOB,1)=%
End DoDot:1
+17 KILL I,INC,Y,ROU
+18 DO KVAR
+19 ;loop to see if any other files came in to pickup
GOTO EN
+20 ;
FINISH ;
+1 IF $EXTRACT(IOST)="C"
WRITE !,"nxtfile4 Finish of ",FILENM
+2 KILL ^TMP($JOB,"PSXDODNT")
PULL SET PATH=$$GET1^DIQ(554,1,20)
SET Y=$$FTG^%ZISH(PATH,FILENM,$NAME(^TMP($JOB,"PSXDODNT",1)),3)
ARCHIVE ;
+1 SET FILENMAR=FILENM
+2 IF FILENM[".TRN"
SET FILENMAR=FILENM_".BW"
+3 SET PATH=$$GET1^DIQ(554,1,22)
FOR XX=1:1:5
SET Y=$$GTF^%ZISH($NAME(^TMP($JOB,"PSXDODNT",1)),3,PATH,FILENMAR)
if Y=1
QUIT
HANG 4
+4 IF Y'=1
SET GBL=$NAME(^TMP($JOB,"PSXDODNT"))
DO FALERT(FILENMAR,PATH,GBL)
REMOVE IF $LENGTH($GET(FILENM))
KILL PSXL
SET PSXL(FILENM)=""
SET PATH=$$GET1^DIQ(554,1,20)
SET Y=$$DEL^%ZISH(PATH,"PSXL")
+1 QUIT
KVAR ;K FILELIST,FILE,Y,PATH,BADFILE
+1 QUIT
ROU ; nest the new command so variables will be protected
+1 NEW FILE,JOBBEG,JOBEND,PSXJOB
+2 IF $EXTRACT(IOST)="C"
WRITE !,FILENM," ",ROU
+3 DO @ROU
+4 QUIT
ZTER ;Friendly RE-cycle error and move to next file
+1 SET XXERR=$$EC^%ZOSV
+2 SET XMSUB="DOD CMOP Error on File "_FILENM
+3 SET BADFILE=FILENM
+4 SET XMTEXT="TEXT("
+5 SET TEXT(1,0)="DOD CMOP encountered the following error. Please investigate"
+6 SET TEXT(2,0)="File: "_FILENM
+7 SET TEXT(3,0)="Error: "_XXERR
+8 SET TEXT(4,0)="The file has been moved into the Hold directory "_$$GET1^DIQ(554,1,23)
+9 DO GRP1^PSXNOTE
+10 ;log error into Kernel K8SYS pg 183
DO ^%ZTER
+11 DO ^XMD
+12 IF $EXTRACT(IOST)="C"
WRITE !,"zter2:Error Finish & Removal of ",FILENM
+13 KILL ^TMP($JOB,"PSXDODNT"),TEXT
PULL2 SET PATH=$$GET1^DIQ(554,1,20)
SET Y=$$FTG^%ZISH(PATH,FILENM,$NAME(^TMP($JOB,"PSXDODNT",1)),3)
HOLD SET PATH=$$GET1^DIQ(554,1,23)
FOR XX=1:1:5
SET Y=$$GTF^%ZISH($NAME(^TMP($JOB,"PSXDODNT",1)),3,PATH,FILENM)
if Y=1
QUIT
HANG 4
+1 IF Y'=1
SET GBL=$NAME(^TMP($JOB,"PSXDODNT"))
DO FALERT(FILENM,PATH,GBL)
ARCHIVE2 SET PATH=$$GET1^DIQ(554,1,22)
FOR XX=1:1:5
SET Y=$$GTF^%ZISH($NAME(^TMP($JOB,"PSXDODNT",1)),3,PATH,FILENM)
if Y=1
QUIT
HANG 4
+1 IF Y'=1
SET GBL=$NAME(^TMP($JOB,"PSXDODNT"))
DO FALERT(FILENM,PATH,GBL)
REMOVE2 KILL PSXL
SET PSXL(FILENM)=""
SET PATH=$$GET1^DIQ(554,1,20)
SET Y=$$DEL^%ZISH(PATH,"PSXL")
+1 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+2 SET XQAMSG="PLEASE INVESTIGATE - CMOP/DOD error "_XXERR_" "_Y
SET XQAID="PSXDODNT"
+3 DO GRP1^PSXNOTE
MERGE XQA=XMY
DO SETUP^XQALERT
+4 HANG 10
+5 ; return to code 1 level above where $ETRAP set ie the F Loop
GOTO UNWIND^%ZTER
+6 QUIT
FALERT(FILE,PATH,GBL) ;fail to pass file into target directory, send alert, store for later
+1 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+2 SET XQAMSG="DOD: "_FILE_" failed placement into: "_PATH_" "_Y
SET XQAID="PSXDODNT"
+3 ;****TESTING
DO GRP1^PSXNOTE
MERGE XQA=XMY
+4 ;S XQA(DUZ)="" ;****TESTING
+5 DO SETUP^XQALERT
STORE ; store file intO XTMP if GBL PROVIDED
+1 if $GET(GBL)=""
QUIT
+2 DO NOW^%DTC
SET NMSPACE="PSXFILE"_"-"_%
+3 ; save for 7 days
SET DTPRG=$$FMADD^XLFDT(DT,7)
+4 KILL ^XTMP(NMSPACE)
+5 SET ^XTMP(NMSPACE,0)=DTPRG_U_DT_U_"DOD FILE TO SEND"
+6 SET ^XTMP(NMSPACE,1)=FILE
SET ^XTMP(NMSPACE,2)=PATH
+7 ; GBL IN FORM OF S GBL=$NA(^TMP($J,"PSXDODNT"))
MERGE ^XTMP(NMSPACE,"T")=@GBL
+8 QUIT
RESEND ; SCAN XTMP and if entries put the files into the boxes
+1 SET NMSPACE="PSXFILE"
+2 FOR
SET NMSPACE=$ORDER(^XTMP(NMSPACE))
if $EXTRACT(NMSPACE,1,7)'="PSXFILE"
QUIT
Begin DoDot:1
+3 SET FILE=^XTMP(NMSPACE,1)
SET PATH=^XTMP(NMSPACE,2)
+4 ;W !,FILE," ",PATH
+5 SET Y=$$GTF^%ZISH($NAME(^XTMP(NMSPACE,"T",1)),3,PATH,FILE)
+6 IF Y'=1
DO FALERT("Resending DOD files ",PATH)
SET NMSPACE="XX"
QUIT
+7 KILL ^XTMP(NMSPACE)
+8 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+9 SET XQAMSG="DOD: "_FILE_" DID PLACE into: "_PATH_" "_Y
SET XQAID="PSXDODNT"
+10 ;W !,XQAMSG
+11 ;****TESTING
DO GRP1^PSXNOTE
MERGE XQA=XMY
+12 ;S XQA(DUZ)="" ;****TESTING
+13 DO SETUP^XQALERT
+14 QUIT
End DoDot:1
CLEAR ; CLEAR PREVIOUS NODES history nodes
+1 SET X="PSXDODNT"
FOR
SET X=$ORDER(^XTMP(X))
if X'["PSXDODNT"
QUIT
WRITE !,X
KILL ^XTMP(X)
+2 QUIT
KILLERR ; kill the error LOG ^XTMP("PSXDODERR", )
+1 KILL ^XTMP("PSXDODERR")
+2 QUIT
START ;enable/start auto error trapping
+1 KILL ^XTMP("PSXNTSTOP-1")
+2 QUIT
STOP ;disable auto error trapping
+1 SET ^XTMP("PSXNTSTOP-1",0)=DT_U_DT_U_"disable PSXDODNT auto error trapping"
+2 QUIT
EDIT ; edit the PSX DODNT option K8 SYS pg 342
+1 DO EDIT^XUTMOPT("PSX DOD CMOP INTERFACE")
+2 QUIT
DISP ; display schedule
+1 DO DISP^XUTMOPT("PSX DOD CMOP INTERFACE")
+2 QUIT
CLEARALL ; clear boxes out, archive, hold of all files
+1 FOR XX=21,22,23
DO CLEARFLS^PSXDODH(XX,"*.*")
+2 QUIT
