DVBANREP ;ALB/NGC - New Requests Export - Processes ; August 1, 2023; 8/13/2024
;;2.7;AMIE;**255**;Apr 10, 1995;Build 21
;Per VHA Directive 6402 this routine should not be modified
;ICRs
; Reference to $$SITE^VASITE in ICR #10112
; Reference to File 200 ^VA(200) in ICR #170
; Reference to File 40.8 ^DIC(40.8) in ICR #728
; Reference to NOW^XLFDT in ICR #10103
; Reference to FMTE^XLFDT in ICR #10103
; Reference to FMADD^XLFDT in ICR #10103
; Reference to TITLE^XLFSTR in ICR #10104
; Reference to GET1^DIQ in ICR #10004
; Reference to ^DIE in ICR #10018
;
Q ;no direct entry
;
;
LOOKBACKINTERVAL() ;CAPRI-12374:NGC - Lookback interval in days for 2507s to be considered (blank reported date) for export. i.e. new 2507 older than nn days aren't included
Q 10
;
;
DIVSTATUS(DVBDIVID,DVBDIVSTATUS) ;CAPRI-12374:NGC - return an array of name/value pairs for a division. One-stop-shop for division information.
;Parameters - DVBDIVID : division Id
; - ByRef DVBDIVSTATUS : returned array - all data points included even if blank
N DVBDIVSTORE,DVBOPTIONDA,DVBV,DVBVAR,DVBVARS,DVBEXISTS
K DVBDIVSTATUS
S DVBOPTIONDA=$$FINDIDBYNAME^DVBLIBTM("DVBA CAPRI NRE PROCESS TM") Q:('+DVBOPTIONDA) 0
;
;div configuration
S DVBDIVSTORE=$$GETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANREDIV("_DVBDIVID_")")
S DVBDIVSTATUS("divStore")=DVBDIVSTORE
S DVBVARS="divId|divTimeList|divRowGroup|||||||lastProcessId|lastRunDTM|lastRunCount"
F DVBV=1:1:$L(DVBVARS,"|") S DVBVAR=$P(DVBVARS,"|",DVBV) S:(DVBVAR'="") DVBDIVSTATUS(DVBVAR)=$P(DVBDIVSTORE,"|",DVBV)
;
;additional metrics
S DVBDIVSTATUS("lastRunText")=$S(DVBDIVSTATUS("lastRunDTM")="":"No previous run",1:$$FMTE^XLFDT(DVBDIVSTATUS("lastRunDTM"),"1PM")_" - "_(+DVBDIVSTATUS("lastRunCount"))_" request(s) exported.")
S DVBDIVSTATUS("name")=$$GET1^DIQ(40.8,DVBDIVID,.01)
S DVBDIVSTATUS("nextRunDTM")=$$GETNEXTRUN(DVBDIVID)
S DVBDIVSTATUS("nextRunText")=$$FMTE^XLFDT(DVBDIVSTATUS("nextRunDTM"),"1PM")
S DVBDIVSTATUS("nextRunCount")=$$GETREQUESTLIST(DVBDIVID)
S DVBDIVSTATUS("summary")="Next scheduled export "_$$FMTE^XLFDT(DVBDIVSTATUS("nextRunDTM"),"1PM")_"~"_DVBDIVSTATUS("nextRunCount")
S DVBDIVSTATUS("optionDA")=DVBOPTIONDA
Q (DVBDIVSTORE'="")
;
;
PROCESSSTATUS(DVBPROCESSID,DVBPROCESSSTATUS) ;CAPRI-12377:NGC - return an array of metrics for a process event
;Parameters - DVBPROCESSID - process Id created at each export
;Returns - ByRef DVBPROCESSSTATUS - array of process metrics
N DVBOPTIONDA,DVBPROCESSSTORE,DVBVARS,DVBV,DVBVAR,DVBPRIO,DVBREQID,DVBADPGBL,DVBTEXT,DVBREQUESTLIST
;
K DVBPROCESSSTATUS
S DVBOPTIONDA=$$FINDIDBYNAME^DVBLIBTM("DVBA CAPRI NRE PROCESS TM") Q:('+DVBOPTIONDA)
;
;Retrieve stored data fields
S DVBPROCESSSTORE=$$GETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANREPROC("_DVBPROCESSID_")")
Q:(DVBPROCESSSTORE="")
S DVBVARS="processId|divId|processDTM|exportMark|prevProcessDTM|runMethod|exportMarkDTM|exportMarkUser|runMethodUser"
F DVBV=1:1:$L(DVBVARS,"|") S DVBVAR=$P(DVBVARS,"|",DVBV) S:DVBVAR'="" DVBPROCESSSTATUS(DVBVAR)=$P(DVBPROCESSSTORE,"|",DVBV)
S DVBPROCESSSTATUS("processDate")=$P(DVBPROCESSSTATUS("processDTM"),".")
;
;Formulate a descriptive 'text' with the Informational Mark. <dateTime> <mark> by <userName> (not for 'new')
S DVBTEXT="" ;this will stay blank for the 'new' status. Only updated for View/In-Progress/Complete
D:(DVBPROCESSSTATUS("exportMarkDTM")'="")
. S DVBTEXT=$$FMTE^XLFDT(DVBPROCESSSTATUS("exportMarkDTM"),"1PM")_". "
. I (DVBPROCESSSTATUS("exportMark")="opened") S DVBTEXT=DVBTEXT_"Opened "
. E S DVBTEXT=DVBTEXT_"Marked as '"_$$TITLE^XLFSTR(DVBPROCESSSTATUS("exportMark"))_"' "
. S DVBTEXT=DVBTEXT_"by "_$$GET1^DIQ(200,DVBPROCESSSTATUS("exportMarkUser"),.01,"I")
S DVBPROCESSSTATUS("exportMarkText")=DVBTEXT
;
;Information on how export was created 'Scheduled' (i.e. taskman), or AdHoc (by <userName>)
S DVBTEXT=DVBPROCESSSTATUS("runMethod") S:(DVBTEXT'="Scheduled") DVBTEXT=DVBTEXT_" by "_$$GET1^DIQ(200,DVBPROCESSSTATUS("runMethodUser"),.01,"I")
S DVBPROCESSSTATUS("runMethodText")=DVBTEXT
;
;Exported Request list
D GETEXPORTEDLIST(DVBPROCESSSTATUS("divId"),DVBPROCESSSTATUS("processDTM"),.DVBREQUESTLIST)
M DVBPROCESSSTATUS("request")=DVBREQUESTLIST
Q
;
;
GETREQUESTLIST(DVBDIVID,DVBREQUESTLIST) ;CAPRI-12374:NGC - Get a list of requests to be included for a division export
;Parameters - DVBDIVID : division Id (an active division at site)
; - ByRef DVBREQUESTLIST : returned list of request Ids
;Returns - DVBCOUNT of requests in returned DVBREQUESTLIST
;Algorithm - Algorithm based on +42 - +64^DVBCREQP.
; for each request cross reference index (new,modified,examAdded,reRouted)
; for all requests in last nn days for the division
; Exclude from report if "Date sent to MAS" is not blank (already reported)
; If rerouted type, then exclude if this is the original site and the request has been accepted downstream
; if included, add to list
N DVBCURRENTSITE,DVBDATE,DVBINDEX,DVBREQID,DVBREQREC,DVBLATESTREROUTE,DVBLATESTSTATUS
K DVBREQUESTLIST
S DVBCURRENTSITE=$P($$SITE^VASITE,"^",3)
F DVBINDEX="C","AC","AD","AR" D
. S DVBDATE=$$FMADD^XLFDT(DT,-$$LOOKBACKINTERVAL())
. ;for each date in the range under consideration
. F S DVBDATE=$O(^DVB(396.3,DVBINDEX,DVBDATE)) Q:DVBDATE="" D
.. ;for each request on that date
.. S DVBREQID="" F S DVBREQID=$O(^DVB(396.3,DVBINDEX,DVBDATE,DVBREQID)) Q:DVBREQID="" D
... S DVBREQREC=^DVB(396.3,DVBREQID,0)
... ;request is not included if has a (Date Reported to MAS) or (not for the division selected)
... Q:($P(DVBREQREC,"^",5)'="") Q:($P($G(^DVB(396.3,DVBREQID,1)),"^",4)'=DVBDIVID)
... ;request is not included if rerouted from this site and accepted elsewhere
... S DVBLATESTREROUTE=$O(^DVB(396.3,DVBREQID,6,99999),-1),DVBLATESTSTATUS="X"
... S:(DVBLATESTREROUTE'="") DVBLATESTSTATUS=$O(^DVB(396.3,DVBREQID,6,DVBLATESTREROUTE,1,99999),-1)
... Q:(DVBCURRENTSITE=$P($G(^DVB(396.3,DVBREQID,6,1,2)),"^",4))&("NA"[DVBLATESTSTATUS) ;rerouted from here and not rejected (ie. New or Accepted)
... S DVBREQUESTLIST(DVBREQID)=""
... Q
.. Q
. Q
;Count final requests
S DVBREQID="" F DVBREQUESTLIST=0:1 S DVBREQID=$O(DVBREQUESTLIST(DVBREQID)) Q:DVBREQID=""
Q DVBREQUESTLIST
;
;
GETNEXTRUN(DVBDIVID) ;CAPRI-12374:NGC - Get the Date,Time of the next scheduled run for a division.
;Algorithm (See also NRE Soln Technical Document)
; Take Date,Time of next run from Taskman properties if no entry use dvbTime now.
; deduct five minutes - or to midnight - which give the time of the last run,
; return the first entry in the export schedule beyond this dvbTime.
N DVBDIVSTORE,DVBDIVTIMELIST,DVBHRS,DVBMINS,DVBNOWTIME,DVBOPTIONDA,DVBSCHEDNEXTDATE,DVBSCHEDNEXTTIME,DVBLASTTIME,DVBTIMEINDEX,DVBTIMEITEM,DVBTIMEARRAY
S DVBOPTIONDA=$$FINDIDBYNAME^DVBLIBTM("DVBA CAPRI NRE PROCESS TM") Q:('+DVBOPTIONDA) ""
; subtract solution run interval from now which should be last time taskman ran this job
S DVBNOWTIME=$P($$NOW^XLFDT,".",2),DVBHRS=$E(DVBNOWTIME,1,2),DVBMINS=$E(DVBNOWTIME,3,4)
S DVBMINS=DVBMINS-1 S:DVBMINS<0 DVBHRS=DVBHRS-1,DVBMINS=DVBMINS+60 S:DVBHRS<0 DVBHRS=0,DVBMINS=0
S DVBLASTTIME="#"_$TR($J(DVBHRS,2)," ",0)_$TR($J(DVBMINS,2)," ",0) ; add # to prevent stripping leading zeroes
;retrieve date and dvbTime of last process
S DVBDIVSTORE=$$GETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANREDIV("_DVBDIVID_")")
;create an array of schedule times
S DVBDIVTIMELIST=$P(DVBDIVSTORE,"|",2),DVBSCHEDNEXTDATE=$P(DT,".",1) S:DVBDIVTIMELIST="" DVBDIVTIMELIST="0800"
F DVBTIMEINDEX=1:1 S DVBTIMEITEM=$P(DVBDIVTIMELIST,",",DVBTIMEINDEX) Q:DVBTIMEITEM="" S DVBTIMEARRAY("#"_DVBTIMEITEM)=""
;$O to get the next run time starting at now-1minutes. If not found choose first time tomorrow
S DVBSCHEDNEXTTIME=$O(DVBTIMEARRAY(DVBLASTTIME)) S:DVBSCHEDNEXTTIME="" DVBSCHEDNEXTDATE=DVBSCHEDNEXTDATE+1,DVBSCHEDNEXTTIME=$O(DVBTIMEARRAY(""))
Q DVBSCHEDNEXTDATE_"."_$E(DVBSCHEDNEXTTIME,2,5)
;
;
GETEXPORTEDLIST(DVBDIVID,DVBEXPORTDTM,DVBREQUESTLIST) ;CAPRI-12377:NGC - Get list of requests 'exported' at the specified DVBEXPORTDTM
;Algorithm. Because ^DVB(396.3,"ADP",<dateReported>,<prio>,<requestId>) index is not reliable . . .
; Recreate list of requests considered in the original export process. i.e. requests upto <lookBackInterval> days before process date in each of 4 indexes
; Include in the export list if the Date/Time reported to MAS is for the export
N DVBINDEX,DVBDATE,DVBREQID
K DVBREQUESTLIST
F DVBINDEX="C","AC","AD","AR" D
. S DVBDATE=$$FMADD^XLFDT($P(DVBEXPORTDTM,"."),-$$LOOKBACKINTERVAL,0,0,0)
. F S DVBDATE=$O(^DVB(396.3,DVBINDEX,DVBDATE)) Q:DVBDATE="" D
.. S DVBREQID="" F S DVBREQID=$O(^DVB(396.3,DVBINDEX,DVBDATE,DVBREQID)) Q:DVBREQID="" D
... Q:($P($G(^DVB(396.3,DVBREQID,1)),"^",4)'=DVBDIVID) ; request not for the division selected
... S:($P(^DVB(396.3,DVBREQID,0),"^",5)=DVBEXPORTDTM) DVBREQUESTLIST(DVBREQID)=$G(DVBREQUESTLIST(DVBREQID))_" "_DVBINDEX_" "
... Q
.. Q
. Q
;Count requests
S DVBREQID="" F DVBREQUESTLIST=0:1 S DVBREQID=$O(DVBREQUESTLIST(DVBREQID)) Q:DVBREQID=""
Q
;
;
PROCESSEXPORT(DVBDIVID,DVBDIVSTATUS,DVBRUNMETHOD) ;CAPRI-12378:NGC - called by TMPROCESS above and also when doing ad-hoc export
;Algorithm
; Get List of included dvbRequests (GETREQUESTLIST)
; Reorder into a sorted list (keyed on category if so configured)
; Get next process Id and update in file
; Create the export file
; Store the new process record
N DVBCSVROW,DVBFILENAME,DVBNOWTIME,DVBOPTIONDA,DVBPROCESSID,DVBPROCESSSTORE,DVBREQSTT,DVBDIVSTORE
N DVBREQCAT,DVBREQDTM,DVBREQID,DVBREQLIST,DVBREQREC
N DVBSOLUTIONSTORE,DVBSORTKEY,DVBSORTLIST,DVBSORTREC,DVBSTATUSSORT
;
S DVBNOWTIME=$$NOW^XLFDT
S DVBOPTIONDA=$$FINDIDBYNAME^DVBLIBTM("DVBA CAPRI NRE PROCESS TM") Q:('+DVBOPTIONDA)
D:($O(DVBDIVSTATUS(""))="") DIVSTATUS(DVBDIVID,.DVBDIVSTATUS)
D GETREQUESTLIST(DVBDIVID,.DVBREQLIST)
;
S DVBREQID=""
F S DVBREQID=$O(DVBREQLIST(DVBREQID)) Q:DVBREQID="" D
. K DIC,DIE,DA,DR,X,Y
. S DVBREQCAT=DVBREQLIST(DVBREQID)
. S DVBREQREC=^DVB(396.3,DVBREQID,0),DVBREQSTT=$P(DVBREQREC,"^",18)
. ;Update Status and Date reported to MAS (only status changes as below - fileMan will update the status change date)
. I DVBREQSTT=1 S DIE="^DVB(396.3,",DA=DVBREQID,DR="17////2" D ^DIE ; New -> Pending,Reported
. I DVBREQSTT=9 S DIE="^DVB(396.3,",DA=DVBREQID,DR="17////2" D ^DIE ; New,Transferred In -> Pending,Reported
. I DVBREQSTT=11 S DIE="^DVB(396.3,",DA=DVBREQID,DR="17////14" D ^DIE ; New,Rerouted -> Rerouted,Pending Acceptance
. S DIE="^DVB(396.3,",DA=DVBREQID,DR="4////"_DVBNOWTIME D ^DIE ; date reported to MAS. All 2507s get this
. K DIC,DIE,DA,DR,X,Y
. Q
;
;get and update the next DVBPROCESSID
S DVBSOLUTIONSTORE=$$GETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANRESOLN")
S DVBPROCESSID=$P(DVBSOLUTIONSTORE,"|",1) S:DVBPROCESSID="" DVBPROCESSID=1000000 S DVBPROCESSID=DVBPROCESSID+1
S $P(DVBSOLUTIONSTORE,"|",1)=DVBPROCESSID
D SETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANRESOLN",DVBSOLUTIONSTORE)
;
;Create Process Record for this export
S DVBDIVSTORE=DVBDIVSTATUS("divStore")
S DVBPROCESSSTORE="" ; processId | divId | dateTime | exportMark | prevRunDTM | runMethod |exportMarkDTM | exportMarkUser | runMethodUser
S $P(DVBPROCESSSTORE,"|",1)=DVBPROCESSID
S $P(DVBPROCESSSTORE,"|",2)=DVBDIVID
S $P(DVBPROCESSSTORE,"|",3)=DVBNOWTIME
S $P(DVBPROCESSSTORE,"|",4)="new"
S $P(DVBPROCESSSTORE,"|",5)=$P(DVBDIVSTORE,"|",11) ; prev run DTM
S $P(DVBPROCESSSTORE,"|",6)=DVBRUNMETHOD
S $P(DVBPROCESSSTORE,"|",7)="" ; mark DTM blank for new entries
S $P(DVBPROCESSSTORE,"|",8)="" ; mark User blank for new entries
S $P(DVBPROCESSSTORE,"|",9)=DUZ ; processing User
D SETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANREPROC("_DVBPROCESSID_")",DVBPROCESSSTORE)
;
;Update Division record with the 'last process id', 'process time' and 'request counts' fields
S $P(DVBDIVSTORE,"|",10)=DVBPROCESSID
S $P(DVBDIVSTORE,"|",11)=$E(DVBNOWTIME_"0000",1,12)
S $P(DVBDIVSTORE,"|",12)=DVBREQLIST
D SETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANREDIV("_DVBDIVID_")",DVBDIVSTORE)
Q
;
;
VALSAVESTRING(DVBDIVSAVESTRING) ;CAPRI-12376:NGC - validate the save string , updating if needed. Return errorText or null
;Parameters - DVBDIVSAVESTRING - the (^) delimited string from CAPRI
;Returns - Error String or ""
N DIVID,DVBTIMELIST,DVBTIMEARRAY,DVBTIMEITEM,DVBINDEX,DVBERROR
S DVBTIMELIST=$TR($P(DVBDIVSAVESTRING,"^",2),": "),DVBERROR=""
S DIVID=$P(DVBDIVSAVESTRING,"^",1)
;Validate divId
Q:(DIVID="") "Invalid Division Id (Blank) in save instruction"
Q:('$D(^DVB(396.1,1,3,"B",DVBDIVID))) "Invalid Division Id ("_DIVID_") in save instruction"
;Validate timeList
Q:(DVBTIMELIST="") "Run Times is a required entry"
F DVBINDEX=1:1 S DVBTIMEITEM=$P(DVBTIMELIST,",",DVBINDEX) Q:DVBTIMEITEM="" D
. I (DVBTIMEITEM'?4N)!($E(DVBTIMEITEM,1,2)>23)!($E(DVBTIMEITEM,3,4)>59) S DVBERROR="Time item '"_DVBTIMEITEM_"' is not valid"
. E S DVBTIMEARRAY("#"_DVBTIMEITEM)=""
S DVBTIMELIST="",DVBTIMEITEM=""
F S DVBTIMEITEM=$O(DVBTIMEARRAY(DVBTIMEITEM)) Q:DVBTIMEITEM="" S DVBTIMELIST=DVBTIMELIST_$S(DVBTIMELIST="":"",1:",")_$E(DVBTIMEITEM,2,5)
S $P(DVBDIVSAVESTRING,"^",2)=DVBTIMELIST
Q DVBERROR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBANREP 13576 printed Mar 25, 2026@15:05:43 Page 2
DVBANREP ;ALB/NGC - New Requests Export - Processes ; August 1, 2023; 8/13/2024
+1 ;;2.7;AMIE;**255**;Apr 10, 1995;Build 21
+2 ;Per VHA Directive 6402 this routine should not be modified
+3 ;ICRs
+4 ; Reference to $$SITE^VASITE in ICR #10112
+5 ; Reference to File 200 ^VA(200) in ICR #170
+6 ; Reference to File 40.8 ^DIC(40.8) in ICR #728
+7 ; Reference to NOW^XLFDT in ICR #10103
+8 ; Reference to FMTE^XLFDT in ICR #10103
+9 ; Reference to FMADD^XLFDT in ICR #10103
+10 ; Reference to TITLE^XLFSTR in ICR #10104
+11 ; Reference to GET1^DIQ in ICR #10004
+12 ; Reference to ^DIE in ICR #10018
+13 ;
+14 ;no direct entry
QUIT
+15 ;
+16 ;
LOOKBACKINTERVAL() ;CAPRI-12374:NGC - Lookback interval in days for 2507s to be considered (blank reported date) for export. i.e. new 2507 older than nn days aren't included
+1 QUIT 10
+2 ;
+3 ;
DIVSTATUS(DVBDIVID,DVBDIVSTATUS) ;CAPRI-12374:NGC - return an array of name/value pairs for a division. One-stop-shop for division information.
+1 ;Parameters - DVBDIVID : division Id
+2 ; - ByRef DVBDIVSTATUS : returned array - all data points included even if blank
+3 NEW DVBDIVSTORE,DVBOPTIONDA,DVBV,DVBVAR,DVBVARS,DVBEXISTS
+4 KILL DVBDIVSTATUS
+5 SET DVBOPTIONDA=$$FINDIDBYNAME^DVBLIBTM("DVBA CAPRI NRE PROCESS TM")
if ('+DVBOPTIONDA)
QUIT 0
+6 ;
+7 ;div configuration
+8 SET DVBDIVSTORE=$$GETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANREDIV("_DVBDIVID_")")
+9 SET DVBDIVSTATUS("divStore")=DVBDIVSTORE
+10 SET DVBVARS="divId|divTimeList|divRowGroup|||||||lastProcessId|lastRunDTM|lastRunCount"
+11 FOR DVBV=1:1:$LENGTH(DVBVARS,"|")
SET DVBVAR=$PIECE(DVBVARS,"|",DVBV)
if (DVBVAR'="")
SET DVBDIVSTATUS(DVBVAR)=$PIECE(DVBDIVSTORE,"|",DVBV)
+12 ;
+13 ;additional metrics
+14 SET DVBDIVSTATUS("lastRunText")=$SELECT(DVBDIVSTATUS("lastRunDTM")="":"No previous run",1:$$FMTE^XLFDT(DVBDIVSTATUS("lastRunDTM"),"1PM")_" - "_(+DVBDIVSTATUS("lastRunCount"))_" request(s) exported.")
+15 SET DVBDIVSTATUS("name")=$$GET1^DIQ(40.8,DVBDIVID,.01)
+16 SET DVBDIVSTATUS("nextRunDTM")=$$GETNEXTRUN(DVBDIVID)
+17 SET DVBDIVSTATUS("nextRunText")=$$FMTE^XLFDT(DVBDIVSTATUS("nextRunDTM"),"1PM")
+18 SET DVBDIVSTATUS("nextRunCount")=$$GETREQUESTLIST(DVBDIVID)
+19 SET DVBDIVSTATUS("summary")="Next scheduled export "_$$FMTE^XLFDT(DVBDIVSTATUS("nextRunDTM"),"1PM")_"~"_DVBDIVSTATUS("nextRunCount")
+20 SET DVBDIVSTATUS("optionDA")=DVBOPTIONDA
+21 QUIT (DVBDIVSTORE'="")
+22 ;
+23 ;
PROCESSSTATUS(DVBPROCESSID,DVBPROCESSSTATUS) ;CAPRI-12377:NGC - return an array of metrics for a process event
+1 ;Parameters - DVBPROCESSID - process Id created at each export
+2 ;Returns - ByRef DVBPROCESSSTATUS - array of process metrics
+3 NEW DVBOPTIONDA,DVBPROCESSSTORE,DVBVARS,DVBV,DVBVAR,DVBPRIO,DVBREQID,DVBADPGBL,DVBTEXT,DVBREQUESTLIST
+4 ;
+5 KILL DVBPROCESSSTATUS
+6 SET DVBOPTIONDA=$$FINDIDBYNAME^DVBLIBTM("DVBA CAPRI NRE PROCESS TM")
if ('+DVBOPTIONDA)
QUIT
+7 ;
+8 ;Retrieve stored data fields
+9 SET DVBPROCESSSTORE=$$GETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANREPROC("_DVBPROCESSID_")")
+10 if (DVBPROCESSSTORE="")
QUIT
+11 SET DVBVARS="processId|divId|processDTM|exportMark|prevProcessDTM|runMethod|exportMarkDTM|exportMarkUser|runMethodUser"
+12 FOR DVBV=1:1:$LENGTH(DVBVARS,"|")
SET DVBVAR=$PIECE(DVBVARS,"|",DVBV)
if DVBVAR'=""
SET DVBPROCESSSTATUS(DVBVAR)=$PIECE(DVBPROCESSSTORE,"|",DVBV)
+13 SET DVBPROCESSSTATUS("processDate")=$PIECE(DVBPROCESSSTATUS("processDTM"),".")
+14 ;
+15 ;Formulate a descriptive 'text' with the Informational Mark. <dateTime> <mark> by <userName> (not for 'new')
+16 ;this will stay blank for the 'new' status. Only updated for View/In-Progress/Complete
SET DVBTEXT=""
+17 if (DVBPROCESSSTATUS("exportMarkDTM")'="")
Begin DoDot:1
+18 SET DVBTEXT=$$FMTE^XLFDT(DVBPROCESSSTATUS("exportMarkDTM"),"1PM")_". "
+19 IF (DVBPROCESSSTATUS("exportMark")="opened")
SET DVBTEXT=DVBTEXT_"Opened "
+20 IF '$TEST
SET DVBTEXT=DVBTEXT_"Marked as '"_$$TITLE^XLFSTR(DVBPROCESSSTATUS("exportMark"))_"' "
+21 SET DVBTEXT=DVBTEXT_"by "_$$GET1^DIQ(200,DVBPROCESSSTATUS("exportMarkUser"),.01,"I")
End DoDot:1
+22 SET DVBPROCESSSTATUS("exportMarkText")=DVBTEXT
+23 ;
+24 ;Information on how export was created 'Scheduled' (i.e. taskman), or AdHoc (by <userName>)
+25 SET DVBTEXT=DVBPROCESSSTATUS("runMethod")
if (DVBTEXT'="Scheduled")
SET DVBTEXT=DVBTEXT_" by "_$$GET1^DIQ(200,DVBPROCESSSTATUS("runMethodUser"),.01,"I")
+26 SET DVBPROCESSSTATUS("runMethodText")=DVBTEXT
+27 ;
+28 ;Exported Request list
+29 DO GETEXPORTEDLIST(DVBPROCESSSTATUS("divId"),DVBPROCESSSTATUS("processDTM"),.DVBREQUESTLIST)
+30 MERGE DVBPROCESSSTATUS("request")=DVBREQUESTLIST
+31 QUIT
+32 ;
+33 ;
GETREQUESTLIST(DVBDIVID,DVBREQUESTLIST) ;CAPRI-12374:NGC - Get a list of requests to be included for a division export
+1 ;Parameters - DVBDIVID : division Id (an active division at site)
+2 ; - ByRef DVBREQUESTLIST : returned list of request Ids
+3 ;Returns - DVBCOUNT of requests in returned DVBREQUESTLIST
+4 ;Algorithm - Algorithm based on +42 - +64^DVBCREQP.
+5 ; for each request cross reference index (new,modified,examAdded,reRouted)
+6 ; for all requests in last nn days for the division
+7 ; Exclude from report if "Date sent to MAS" is not blank (already reported)
+8 ; If rerouted type, then exclude if this is the original site and the request has been accepted downstream
+9 ; if included, add to list
+10 NEW DVBCURRENTSITE,DVBDATE,DVBINDEX,DVBREQID,DVBREQREC,DVBLATESTREROUTE,DVBLATESTSTATUS
+11 KILL DVBREQUESTLIST
+12 SET DVBCURRENTSITE=$PIECE($$SITE^VASITE,"^",3)
+13 FOR DVBINDEX="C","AC","AD","AR"
Begin DoDot:1
+14 SET DVBDATE=$$FMADD^XLFDT(DT,-$$LOOKBACKINTERVAL())
+15 ;for each date in the range under consideration
+16 FOR
SET DVBDATE=$ORDER(^DVB(396.3,DVBINDEX,DVBDATE))
if DVBDATE=""
QUIT
Begin DoDot:2
+17 ;for each request on that date
+18 SET DVBREQID=""
FOR
SET DVBREQID=$ORDER(^DVB(396.3,DVBINDEX,DVBDATE,DVBREQID))
if DVBREQID=""
QUIT
Begin DoDot:3
+19 SET DVBREQREC=^DVB(396.3,DVBREQID,0)
+20 ;request is not included if has a (Date Reported to MAS) or (not for the division selected)
+21 if ($PIECE(DVBREQREC,"^",5)'="")
QUIT
if ($PIECE($GET(^DVB(396.3,DVBREQID,1)),"^",4)'=DVBDIVID)
QUIT
+22 ;request is not included if rerouted from this site and accepted elsewhere
+23 SET DVBLATESTREROUTE=$ORDER(^DVB(396.3,DVBREQID,6,99999),-1)
SET DVBLATESTSTATUS="X"
+24 if (DVBLATESTREROUTE'="")
SET DVBLATESTSTATUS=$ORDER(^DVB(396.3,DVBREQID,6,DVBLATESTREROUTE,1,99999),-1)
+25 ;rerouted from here and not rejected (ie. New or Accepted)
if (DVBCURRENTSITE=$PIECE($GET(^DVB(396.3,DVBREQID,6,1,2)),"^",4))&("NA"[DVBLATESTSTATUS)
QUIT
+26 SET DVBREQUESTLIST(DVBREQID)=""
+27 QUIT
End DoDot:3
+28 QUIT
End DoDot:2
+29 QUIT
End DoDot:1
+30 ;Count final requests
+31 SET DVBREQID=""
FOR DVBREQUESTLIST=0:1
SET DVBREQID=$ORDER(DVBREQUESTLIST(DVBREQID))
if DVBREQID=""
QUIT
+32 QUIT DVBREQUESTLIST
+33 ;
+34 ;
GETNEXTRUN(DVBDIVID) ;CAPRI-12374:NGC - Get the Date,Time of the next scheduled run for a division.
+1 ;Algorithm (See also NRE Soln Technical Document)
+2 ; Take Date,Time of next run from Taskman properties if no entry use dvbTime now.
+3 ; deduct five minutes - or to midnight - which give the time of the last run,
+4 ; return the first entry in the export schedule beyond this dvbTime.
+5 NEW DVBDIVSTORE,DVBDIVTIMELIST,DVBHRS,DVBMINS,DVBNOWTIME,DVBOPTIONDA,DVBSCHEDNEXTDATE,DVBSCHEDNEXTTIME,DVBLASTTIME,DVBTIMEINDEX,DVBTIMEITEM,DVBTIMEARRAY
+6 SET DVBOPTIONDA=$$FINDIDBYNAME^DVBLIBTM("DVBA CAPRI NRE PROCESS TM")
if ('+DVBOPTIONDA)
QUIT ""
+7 ; subtract solution run interval from now which should be last time taskman ran this job
+8 SET DVBNOWTIME=$PIECE($$NOW^XLFDT,".",2)
SET DVBHRS=$EXTRACT(DVBNOWTIME,1,2)
SET DVBMINS=$EXTRACT(DVBNOWTIME,3,4)
+9 SET DVBMINS=DVBMINS-1
if DVBMINS<0
SET DVBHRS=DVBHRS-1
SET DVBMINS=DVBMINS+60
if DVBHRS<0
SET DVBHRS=0
SET DVBMINS=0
+10 ; add # to prevent stripping leading zeroes
SET DVBLASTTIME="#"_$TRANSLATE($JUSTIFY(DVBHRS,2)," ",0)_$TRANSLATE($JUSTIFY(DVBMINS,2)," ",0)
+11 ;retrieve date and dvbTime of last process
+12 SET DVBDIVSTORE=$$GETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANREDIV("_DVBDIVID_")")
+13 ;create an array of schedule times
+14 SET DVBDIVTIMELIST=$PIECE(DVBDIVSTORE,"|",2)
SET DVBSCHEDNEXTDATE=$PIECE(DT,".",1)
if DVBDIVTIMELIST=""
SET DVBDIVTIMELIST="0800"
+15 FOR DVBTIMEINDEX=1:1
SET DVBTIMEITEM=$PIECE(DVBDIVTIMELIST,",",DVBTIMEINDEX)
if DVBTIMEITEM=""
QUIT
SET DVBTIMEARRAY("#"_DVBTIMEITEM)=""
+16 ;$O to get the next run time starting at now-1minutes. If not found choose first time tomorrow
+17 SET DVBSCHEDNEXTTIME=$ORDER(DVBTIMEARRAY(DVBLASTTIME))
if DVBSCHEDNEXTTIME=""
SET DVBSCHEDNEXTDATE=DVBSCHEDNEXTDATE+1
SET DVBSCHEDNEXTTIME=$ORDER(DVBTIMEARRAY(""))
+18 QUIT DVBSCHEDNEXTDATE_"."_$EXTRACT(DVBSCHEDNEXTTIME,2,5)
+19 ;
+20 ;
GETEXPORTEDLIST(DVBDIVID,DVBEXPORTDTM,DVBREQUESTLIST) ;CAPRI-12377:NGC - Get list of requests 'exported' at the specified DVBEXPORTDTM
+1 ;Algorithm. Because ^DVB(396.3,"ADP",<dateReported>,<prio>,<requestId>) index is not reliable . . .
+2 ; Recreate list of requests considered in the original export process. i.e. requests upto <lookBackInterval> days before process date in each of 4 indexes
+3 ; Include in the export list if the Date/Time reported to MAS is for the export
+4 NEW DVBINDEX,DVBDATE,DVBREQID
+5 KILL DVBREQUESTLIST
+6 FOR DVBINDEX="C","AC","AD","AR"
Begin DoDot:1
+7 SET DVBDATE=$$FMADD^XLFDT($PIECE(DVBEXPORTDTM,"."),-$$LOOKBACKINTERVAL,0,0,0)
+8 FOR
SET DVBDATE=$ORDER(^DVB(396.3,DVBINDEX,DVBDATE))
if DVBDATE=""
QUIT
Begin DoDot:2
+9 SET DVBREQID=""
FOR
SET DVBREQID=$ORDER(^DVB(396.3,DVBINDEX,DVBDATE,DVBREQID))
if DVBREQID=""
QUIT
Begin DoDot:3
+10 ; request not for the division selected
if ($PIECE($GET(^DVB(396.3,DVBREQID,1)),"^",4)'=DVBDIVID)
QUIT
+11 if ($PIECE(^DVB(396.3,DVBREQID,0),"^",5)=DVBEXPORTDTM)
SET DVBREQUESTLIST(DVBREQID)=$GET(DVBREQUESTLIST(DVBREQID))_" "_DVBINDEX_" "
+12 QUIT
End DoDot:3
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 ;Count requests
+16 SET DVBREQID=""
FOR DVBREQUESTLIST=0:1
SET DVBREQID=$ORDER(DVBREQUESTLIST(DVBREQID))
if DVBREQID=""
QUIT
+17 QUIT
+18 ;
+19 ;
PROCESSEXPORT(DVBDIVID,DVBDIVSTATUS,DVBRUNMETHOD) ;CAPRI-12378:NGC - called by TMPROCESS above and also when doing ad-hoc export
+1 ;Algorithm
+2 ; Get List of included dvbRequests (GETREQUESTLIST)
+3 ; Reorder into a sorted list (keyed on category if so configured)
+4 ; Get next process Id and update in file
+5 ; Create the export file
+6 ; Store the new process record
+7 NEW DVBCSVROW,DVBFILENAME,DVBNOWTIME,DVBOPTIONDA,DVBPROCESSID,DVBPROCESSSTORE,DVBREQSTT,DVBDIVSTORE
+8 NEW DVBREQCAT,DVBREQDTM,DVBREQID,DVBREQLIST,DVBREQREC
+9 NEW DVBSOLUTIONSTORE,DVBSORTKEY,DVBSORTLIST,DVBSORTREC,DVBSTATUSSORT
+10 ;
+11 SET DVBNOWTIME=$$NOW^XLFDT
+12 SET DVBOPTIONDA=$$FINDIDBYNAME^DVBLIBTM("DVBA CAPRI NRE PROCESS TM")
if ('+DVBOPTIONDA)
QUIT
+13 if ($ORDER(DVBDIVSTATUS(""))="")
DO DIVSTATUS(DVBDIVID,.DVBDIVSTATUS)
+14 DO GETREQUESTLIST(DVBDIVID,.DVBREQLIST)
+15 ;
+16 SET DVBREQID=""
+17 FOR
SET DVBREQID=$ORDER(DVBREQLIST(DVBREQID))
if DVBREQID=""
QUIT
Begin DoDot:1
+18 KILL DIC,DIE,DA,DR,X,Y
+19 SET DVBREQCAT=DVBREQLIST(DVBREQID)
+20 SET DVBREQREC=^DVB(396.3,DVBREQID,0)
SET DVBREQSTT=$PIECE(DVBREQREC,"^",18)
+21 ;Update Status and Date reported to MAS (only status changes as below - fileMan will update the status change date)
+22 ; New -> Pending,Reported
IF DVBREQSTT=1
SET DIE="^DVB(396.3,"
SET DA=DVBREQID
SET DR="17////2"
DO ^DIE
+23 ; New,Transferred In -> Pending,Reported
IF DVBREQSTT=9
SET DIE="^DVB(396.3,"
SET DA=DVBREQID
SET DR="17////2"
DO ^DIE
+24 ; New,Rerouted -> Rerouted,Pending Acceptance
IF DVBREQSTT=11
SET DIE="^DVB(396.3,"
SET DA=DVBREQID
SET DR="17////14"
DO ^DIE
+25 ; date reported to MAS. All 2507s get this
SET DIE="^DVB(396.3,"
SET DA=DVBREQID
SET DR="4////"_DVBNOWTIME
DO ^DIE
+26 KILL DIC,DIE,DA,DR,X,Y
+27 QUIT
End DoDot:1
+28 ;
+29 ;get and update the next DVBPROCESSID
+30 SET DVBSOLUTIONSTORE=$$GETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANRESOLN")
+31 SET DVBPROCESSID=$PIECE(DVBSOLUTIONSTORE,"|",1)
if DVBPROCESSID=""
SET DVBPROCESSID=1000000
SET DVBPROCESSID=DVBPROCESSID+1
+32 SET $PIECE(DVBSOLUTIONSTORE,"|",1)=DVBPROCESSID
+33 DO SETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANRESOLN",DVBSOLUTIONSTORE)
+34 ;
+35 ;Create Process Record for this export
+36 SET DVBDIVSTORE=DVBDIVSTATUS("divStore")
+37 ; processId | divId | dateTime | exportMark | prevRunDTM | runMethod |exportMarkDTM | exportMarkUser | runMethodUser
SET DVBPROCESSSTORE=""
+38 SET $PIECE(DVBPROCESSSTORE,"|",1)=DVBPROCESSID
+39 SET $PIECE(DVBPROCESSSTORE,"|",2)=DVBDIVID
+40 SET $PIECE(DVBPROCESSSTORE,"|",3)=DVBNOWTIME
+41 SET $PIECE(DVBPROCESSSTORE,"|",4)="new"
+42 ; prev run DTM
SET $PIECE(DVBPROCESSSTORE,"|",5)=$PIECE(DVBDIVSTORE,"|",11)
+43 SET $PIECE(DVBPROCESSSTORE,"|",6)=DVBRUNMETHOD
+44 ; mark DTM blank for new entries
SET $PIECE(DVBPROCESSSTORE,"|",7)=""
+45 ; mark User blank for new entries
SET $PIECE(DVBPROCESSSTORE,"|",8)=""
+46 ; processing User
SET $PIECE(DVBPROCESSSTORE,"|",9)=DUZ
+47 DO SETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANREPROC("_DVBPROCESSID_")",DVBPROCESSSTORE)
+48 ;
+49 ;Update Division record with the 'last process id', 'process time' and 'request counts' fields
+50 SET $PIECE(DVBDIVSTORE,"|",10)=DVBPROCESSID
+51 SET $PIECE(DVBDIVSTORE,"|",11)=$EXTRACT(DVBNOWTIME_"0000",1,12)
+52 SET $PIECE(DVBDIVSTORE,"|",12)=DVBREQLIST
+53 DO SETNAMEDVALUE^DVBLIBTM(DVBOPTIONDA,"DVBANREDIV("_DVBDIVID_")",DVBDIVSTORE)
+54 QUIT
+55 ;
+56 ;
VALSAVESTRING(DVBDIVSAVESTRING) ;CAPRI-12376:NGC - validate the save string , updating if needed. Return errorText or null
+1 ;Parameters - DVBDIVSAVESTRING - the (^) delimited string from CAPRI
+2 ;Returns - Error String or ""
+3 NEW DIVID,DVBTIMELIST,DVBTIMEARRAY,DVBTIMEITEM,DVBINDEX,DVBERROR
+4 SET DVBTIMELIST=$TRANSLATE($PIECE(DVBDIVSAVESTRING,"^",2),": ")
SET DVBERROR=""
+5 SET DIVID=$PIECE(DVBDIVSAVESTRING,"^",1)
+6 ;Validate divId
+7 if (DIVID="")
QUIT "Invalid Division Id (Blank) in save instruction"
+8 if ('$DATA(^DVB(396.1,1,3,"B",DVBDIVID)))
QUIT "Invalid Division Id ("_DIVID_") in save instruction"
+9 ;Validate timeList
+10 if (DVBTIMELIST="")
QUIT "Run Times is a required entry"
+11 FOR DVBINDEX=1:1
SET DVBTIMEITEM=$PIECE(DVBTIMELIST,",",DVBINDEX)
if DVBTIMEITEM=""
QUIT
Begin DoDot:1
+12 IF (DVBTIMEITEM'?4N)!($EXTRACT(DVBTIMEITEM,1,2)>23)!($EXTRACT(DVBTIMEITEM,3,4)>59)
SET DVBERROR="Time item '"_DVBTIMEITEM_"' is not valid"
+13 IF '$TEST
SET DVBTIMEARRAY("#"_DVBTIMEITEM)=""
End DoDot:1
+14 SET DVBTIMELIST=""
SET DVBTIMEITEM=""
+15 FOR
SET DVBTIMEITEM=$ORDER(DVBTIMEARRAY(DVBTIMEITEM))
if DVBTIMEITEM=""
QUIT
SET DVBTIMELIST=DVBTIMELIST_$SELECT(DVBTIMELIST="":"",1:",")_$EXTRACT(DVBTIMEITEM,2,5)
+16 SET $PIECE(DVBDIVSAVESTRING,"^",2)=DVBTIMELIST
+17 QUIT DVBERROR
