- 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 Jan 18, 2025@02:45:19 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