DVBACER1 ;BEST/JFW - DEMTRAN CONTRACTED EXAM REPORTS ; 6/27/12 3:56pm
 ;;2.7;AMIE;**178,185,186**;Apr 10, 1995;Build 21
 ;Per VHA Directive 2004-038, this routine should not be modified.
 ;
 ;  - RPC: DVBAD CONTRACTED EXAM REPORTS
 ;  
 ;  Creates Detailed, Summary, or Timeliness Contracted Exam Reports
 ;  for the Disability Examination Management Tracking, Referral and
 ;  Notification application (demTRAN).
 ;
 ;Input:
 ;     DVBALST:   Global array to hold results to be returned
 ;     DVBARTYP:  Report Type to Generate (Required)
 ;                 D : Detailed
 ;                 S : Summary
 ;                 T : Timeliness
 ;     DVBAFLTRS: Report Filters (Optional)
 ;        ("DATE")       = FM From Date ^ FM To Date (Inclusive) 
 ;        ("CONTRACTOR") = IEN of Contractor in 396.45
 ;        ("PENDING")    = 1 indicating Pending Exams Only ^
 ;                         # of Days Referral Exceeded (Optional)
 ;        ("SORT")       = 1 indicating Contractor sorted else
 ;                         Request DTM sorted (Detailed Reports Only)
 ;        ("DELIMITTED") = 1 indicating Report returned Delimitted
 ;                         (Detailed Reports Only)
 ;
CERPTS(DVBALST,DVBARTYP,DVBAFLTRS) ;Contracted Exam Reports
 
DVBAQ,DVBASDTE,DVBAEDTE,DVBACIEN,DVBAPEXMS,DVBAPDAYS,DVBAHFS
 
DVBARIEN,DVBAEIEN,DVBAENDE,DVBAGLBL,DVBARSLTS,DVBASCRH
 
DVBACSRT,DVBADLMT,X1,X2,X,%H,%Y
 
GETARY,ERARY,RSTAT
 
^TMP($J,"DVBACER1")
 
DVBAHFS=$$GETHFS()
 
DVBASCRH=$NA(^TMP($J,"DVBASCRATCH"))
 
DVBAGLBL=$NA(^TMP($J,"DVBA"_$G(DVBARTYP)_"RPTS"))
 
DVBARSLTS=$NA(^TMP("DVBA"_$G(DVBARTYP)_"RSLTS",$J,1))
 
@DVBAGLBL,@DVBARSLTS,@DVBASCRH
 
Q:($$OPENHFS("DVBRP",DVBAHFS,"W",DVBARSLTS))  ;Quit if error
 
IO
 
; Initial start values if filters undefined
 
(DVBAEDTE,DVBACIEN)=""
 
(DVBASDTE,DVBAPEXMS,DVBAPDAYS,DVBACSRT,DVBADLMT)=0
 
;
 ;Date filter defined, set loop conditions
 
D:($D(DVBAFLTRS("DATE")))
 .
DVBASDTE=$P($G(DVBAFLTRS("DATE")),"^")_".2359"
 
.X1=DVBASDTE,X2=-1 C^%DTC DVBASDTE=X
 
.DVBAEDTE=$P($G(DVBAFLTRS("DATE")),"^",2)_".2359"
 ;Contractor filter defined
 
S:($D(DVBAFLTRS("CONTRACTOR"))) DVBACIEN=$G(DVBAFLTRS("CONTRACTOR"))
 
;Pending Exam filter defined
 
D:($D(DVBAFLTRS("PENDING")))
 .
DVBAPEXMS=1,DVBAPDAYS=+$P($G(DVBAFLTRS("PENDING")),"^",2)
 
;Sorting (Contractor or Request DTM - for Detailed Reports Only)
 
S:($D(DVBAFLTRS("SORT"))) DVBACSRT=1
 
;Delimitted Output (for Detailed Reports Only)
 
S:($D(DVBAFLTRS("DELIMITTED"))) DVBADLMT=1
 
;
 ;Get Contractor(s) list for Timeliness and Summary Reports
 ; if specific contractor NOT defined
 
D:(($G(DVBARTYP)'="D")&(DVBACIEN']"")) CONLST(DVBACIEN,DVBARSLTS)
 
;
 ;Use "C" X-REF so results are in Date/Time Order
 
F  S DVBASDTE=$O(^DVB(396.3,"C",DVBASDTE)) Q:('+DVBASDTE)!((DVBAEDTE]"")&(DVBASDTE>DVBAEDTE))  D
 
.DVBARIEN=""  ;In case there is more than 1 request ien for dtm
 
.F  S DVBARIEN=$O(^DVB(396.3,"C",DVBASDTE,DVBARIEN)) Q:'+DVBARIEN  D
 
..;Use "C" X-REF for retrieving exams for request IEN
 
..($G(DVBARTYP)="T"CERPTS2 Q
 
..DVBAEIEN=""
 
..F  S DVBAEIEN=$O(^DVB(396.4,"C",DVBARIEN,DVBAEIEN)) Q:'+DVBAEIEN  D
 
...DVBAENDE=$G(^DVB(396.4,DVBAEIEN,"CNTRCTR"))
 ...
;Ignore exams that have NOT been contracted out
 
...;Q:($P(DVBAENDE,"^",2)']"")
 
...($P(DVBAENDE,"^",2)']""Q
 
...;Ignore exams NOT for specified contractor if defined
 
...;Q:((DVBACIEN]"")&(DVBACIEN'=(+DVBAENDE)))
 
...((DVBACIEN]"")&(DVBACIEN'=(+DVBAENDE))) Q
 
...;DETAILED & SUMMARY REPORTING
 
...D:($G(DVBARTYP)'="T")
 ....
DVBAQ=0
 ....
(DVBAPEXMSD  Q:(DVBAQ)  ;Pending Exams
 
.....;Ignore Exams NOT received back from contractor
 
.....S:($P(DVBAENDE,"^",3)]""DVBAQ=1
 .....
D:(('DVBAQ)&(DVBAPDAYS]""))
 ......
;Ignore Pending Exams less than requested days
 
......X1=DT,X2=$P(DVBAENDE,"^",2) ^%DTC
 ......
S:(X<=DVBAPDAYSDVBAQ=1
 ....
D:($G(DVBARTYP)="D"DRPTS(DVBACSRT,DVBARIEN,DVBAEIEN,DVBASCRH)
 ....
D:($G(DVBARTYP)="S"SRPTS(DVBARIEN,DVBAENDE,DVBAGLBL,DVBARSLTS)
 ..
D:($G(DVBARTYP)="T"TRPTS3(DVBAGLBL,DVBARSLTS)
 
D:($G(DVBARTYP)="D"DSPLYDTL(DVBACSRT,DVBACIEN,DVBAPEXMS,DVBASCRH,DVBADLMT)  ;Rpt Details
 
CLOSEHFS("DVBRP",DVBAHFS,DVBARSLTS)
 
DVBALST=$NA(@DVBARSLTS)
 
@DVBAGLBL,@DVBASCRH
 
Q
 
;
 ;
CERPTS2 ;Logic for timeliness report
 
EXSTAT
 
^TMP($J,"DVBACER1")
 
DVBAEIEN=""
 
F  S DVBAEIEN=$O(^DVB(396.4,"C",DVBARIEN,DVBAEIEN)) Q:'+DVBAEIEN  D
 
.DVBAENDE=$G(^DVB(396.4,DVBAEIEN,"CNTRCTR"))
 .
;Ignore exams that have NOT been contracted out
 
.Q:($P(DVBAENDE,"^",2)']"")
 .
;Ignore exams NOT for specified contractor if defined
 
.Q:((DVBACIEN]"")&(DVBACIEN'=(+DVBAENDE)))
 .
;TIMELINESS REPORTING
 
.;Innore exams that have been canceled
 
.EXSTAT=$P(^DVB(396.4,DVBAEIEN,0),"^",4)
 .
Q:EXSTAT="X"!(EXSTAT="RX"
 .
TRPTS2(DVBAENDE)
 
TRPTS3(DVBAGLBL,DVBARSLTS)
 
Q
 
;
 ;Input  DVBACIEN - Specific Contrator Data Requested
 ;       DVBARSLTS - Global Refernece for results
 ;Output Global Array Entries Added for Contractor(s)
 ;       ^TMP("DVBATRSLTS",$J)
CONLST(DVBACIEN,DVBARSLTS) ;Get Contractor List
 ;Used in Timeliness and Summary Reports
 
DVBACNDE
 
;Specific Contractor Info Requested
 
(DVBACIEN]""D  Q
 
.DVBACNDE=$G(^DVB(396.45,DVBACIEN,0))
 .
@DVBARSLTS@(DVBACIEN)=$P(DVBACNDE,"^")_"^"_$P(DVBACNDE,"^",3)_"^"
 ;All Contractor Info Requested
 
DVBACIEN=0 F  S DVBACIEN=$O(^DVB(396.45,DVBACIEN)) Q:'+DVBACIEN  D
 
.DVBACNDE=$G(^DVB(396.45,DVBACIEN,0))
 .
;Create list of contractor info and initialize counters
 
.; for the specific report to 0
 
.@DVBARSLTS@($P(DVBACNDE,"^"),DVBACIEN)=$P(DVBACNDE,"^")_"^"_$P(DVBACNDE,"^",3)_"^0"
 
.S:($G(DVBARTYP)="S") @DVBARSLTS@($P(DVBACNDE,"^"),DVBACIEN)=@DVBARSLTS@($P(DVBACNDE,"^"),DVBACIEN)_"^0"
 
Q
 
;
 ;Input  DVBACSRT - 1/0 if report should be sorted by Contractor
 ;                  Name (1) or by Request Date (0)
 ;       DVBARIEN - IEN of Request (396.3) associated with Exam
 ;       DVBAEIEN - IEN of Exam (396.4)
 ;       DVBASCRH - Global Reference for results (Scratch Global)
 ;Output Global Array Entry Added (Sorted) - ^TMP($J,"DVBASCRH")
DRPTS(DVBACSRT,DVBARIEN,DVBAEIEN,DVBASCRH) ; Detailed Report Processing
 
DVBACNME,DVBAENME,DVBARDTM,DVBAEXM
 
;Retrieve Exam Info
 
GETS^DIQ(396.4,DVBAEIEN_",",".03;100","E","DVBAEXM")
 
DVBACNME=$G(DVBAEXM(396.4,DVBAEIEN_",",100,"E"))  ;Contractor
 
S:(DVBACNME']""DVBACNME="UNKNOWN"
 
DVBAENME=$G(DVBAEXM(396.4,DVBAEIEN_",",.03,"E"))  ;Exam Name
 
S:(DVBAENME']""DVBAENME="UNKNOWN"
 
DVBAENME=$TR(DVBAENME,","," ")  ;Remove Commas
 
DVBARDTM=$P($G(^DVB(396.3,DVBARIEN,0)),"^",2)  ;Request DateTime
 
S:('DVBACSRT) @DVBASCRH@(DVBARDTM,DVBARIEN,DVBAENME,DVBAEIEN)=""
 
S:(DVBACSRT) @DVBASCRH@($TR(DVBACNME,","," "),DVBARDTM,DVBARIEN,DVBAENME,DVBAEIEN)=DVBACNME
 
Q
 
;
 ;Input  DVBACSRT - 1/0 if report should be sorted by Contractor
 ;                  Name (1) or by Request Date (0)
 ;       DVBAEIEN  - IEN of Exam (396.4)
 ;       DVBAPEXMS - 1/0 Indicates if only pending exams report
 ;       DVBASCRH  - Global Reference for results (Scratch Global)
 ;       DVBADLMT  - 1/0 if report output should be delimitted
 ;                   Delimitted Output (1) or Formatted Output (0)
 ;Output Write Report Details
DSPLYDTL(DVBACSRT,DVBACIEN,DVBAPEXMS,DVBASCRH,DVBADLMT) ;Display Sorted Detailed Report Info
 
DVBAREF,DVBACNME,DVBARIEN,DVBAINFO,DVBAOFST
 
DVBASPCG,DVBALNE,DFN,VADM,X
 
DRPTSPCG(DVBACSRT,DVBADLMT,.DVBASPCG)
 
DVBAREF=DVBASCRH,DVBAOFST=0,(DVBACNME,DVBARIEN)=""
 
S:('DVBACSRTDVBAOFST=1
 
;Quit if no results found
 
Q:('$D(@DVBASCRH))
 
;Report Column Header Info
 
W:((DVBACIEN']"")&(DVBACSRT)) "Contractor",$S(DVBADLMT:"^",1:"")
 
W:((DVBACIEN']"")&(DVBACSRT)&('DVBADLMT)) !
 
?DVBASPCG(1),"Request Date",$S(DVBADLMT:"^",1:""),?DVBASPCG(2),"SSN",$S(DVBADLMT:"^",1:"")
 
?DVBASPCG(3),"Patient Name",$S(DVBADLMT:"^",1:""),?DVBASPCG(4),"Status",$S(DVBADLMT:"^",1:"")
 
W:('DVBADLMT) !
 
?DVBASPCG(5),"Examinations",$S(DVBADLMT:"^",1:"")
 
W:(('DVBACSRT)&(DVBACIEN']"")) ?DVBASPCG(6),"Contractor",$S(DVBADLMT:"^",1:"")
 
?DVBASPCG(7),"Referred"
 
DVBALNE=(DVBASPCG(7)+18)
 
D:('DVBAPEXMS
 .
?DVBASPCG(8),$S(DVBADLMT:"^",1:""),"Received"
 
.DVBALNE=(DVBASPCG(8)+12)
 
X="" S $P(X,"-",DVBALNE)="-" W:('DVBADLMT) !,X  ;Header Line
 
F  S DVBAREF=$Q(@DVBAREFQ:(DVBAREF'[$P(DVBASCRH,")"))  D
 
.;Display Contractor Name, if NOT specific contractor report
 
.D:((DVBACIEN']"")&(DVBACSRT)&(DVBADLMT))  ; Delimitted Output
 
..!,@DVBAREF_"^"
 
.D:((DVBACNME'=@DVBAREF)&(DVBACIEN']"")&(DVBACSRT)&('DVBADLMT))  ;Formatted Output
 
..W:(DVBACNME]"") !  ;Extra Line Space between Contractors
 
..DVBACNME=@DVBAREF
 
..!,DVBACNME
 
.;Display Request Info (Multiple Exams)
 
.D:(DVBARIEN'=$P(DVBAREF,",",(5-DVBAOFST)))
 ..
DVBARIEN=$P(DVBAREF,",",(5-DVBAOFST))
 ..
DFN=+$G(^DVB(396.3,DVBARIEN,0))  ; Patient
 
..DEM^VADPT  ;DBIA: 10061
 
..GETS^DIQ(396.3,DVBARIEN_",","17","E","DVBAINFO")
 ..
D:('DVBADLMT)  ;Formatted Report
 
...!?DVBASPCG(1),$$FMTE^XLFDT($P(DVBAREF,",",(4-DVBAOFST)),"M")  ;No Seconds
 
...?DVBASPCG(2),$P($G(VADM(2)),"^",2),?DVBASPCG(3),$G(VADM(1))
 ...
?DVBASPCG(4),$G(DVBAINFO(396.3,DVBARIEN_",",17,"E"))
 .
D:(DVBADLMT)  ;Detailed Report
 
..W:'((DVBACIEN']"")&(DVBACSRT)) !
 ..
W $$FMTE^XLFDT($P(DVBAREF,",",(4-DVBAOFST)),"M")_"^"  ;No Seconds
 
..W $P($G(VADM(2)),"^",2)_"^"_$G(VADM(1))_"^"
 
..W $G(DVBAINFO(396.3,DVBARIEN_",",17,"E"))_"^"
 
.;Exam Info for Request
 
.EXMINFO(DVBAPEXMS,+$P(DVBAREF,",",(7-DVBAOFST)),DVBACSRT,DVBADLMT,.DVBASPCG)
 
DVBAINFO,VADM
 
Q
 
;
 ;Input  DVBAPEXMS - 1/0 Indicates if only pending exams report
 ;       DVBAEIEN  - IEN of Exam (396.4)
 ;       DVBACSRT  - 1/0 if report should be sorted by Contractor
 ;                   Name (1) or by Request Date (0)
 ;       DVBADLMT  - 1/0 if report output should be delimitted
 ;                   Delimitted Output (1) or Formatted Output (0)
 ;       DVBASPCG  - Array to store spacing (By Ref)
 ;Output Write EXAM Info for request to report
EXMINFO(DVBAPEXMS,DVBAEIEN,DVBACSRT,DVBADLMT,DVBASPCG) ;Display Exam Info
 
DVBAEXM
 
;Retrieve exam info for display on report
 
GETS^DIQ(396.4,DVBAEIEN_",",".03;100;101;102","EI","DVBAEXM")
 
W:('DVBADLMT) !
 
?DVBASPCG(5),$G(DVBAEXM(396.4,DVBAEIEN_",",.03,"E")),$S(DVBADLMT:"^",1:"")
 
W:('DVBACSRT) ?DVBASPCG(6),$G(DVBAEXM(396.4,DVBAEIEN_",",100,"E")),$S(DVBADLMT:"^",1:"")
 
?DVBASPCG(7),$$FMTE^XLFDT($P($G(DVBAEXM(396.4,DVBAEIEN_",",101,"I")),"@"),"M"),$S(DVBADLMT:"^",1:"")
 
W:('DVBAPEXMS) ?DVBASPCG(8),$P($G(DVBAEXM(396.4,DVBAEIEN_",",102,"E")),"@")
 
Q
 
;
 ;Input  DVBACSRT - 1/0 if report should be sorted by Contractor
 ;                  Name (1) or by Request Date (0)
 ;       DVBADLMT - 1/0 if report output should be delimitted
 ;                  Delimitted Output (1) or Formatted Output (0)
 ;       DVBASPCG - Array to store spacing (By Ref)
DRPTSPCG(DVBACSRT,DVBADLMT,DVBASPCG) ;Setup Detailed Report Spacing
 
DVBAOFST,DVBAI
 
DVBAOFST=0 S:('DVBACSRT&'DVBADLMTDVBAOFST=3
 
DVBASPCG
 
D:(DVBADLMT)
 .
DVBAI=1:1:8  DVBASPCG(DVBAI)=0
 
D:('DVBADLMT)
 .
DVBASPCG(1)=3-DVBAOFST,DVBASPCG(2)=23-DVBAOFST
 
.DVBASPCG(3)=36-DVBAOFST,DVBASPCG(4)=68-DVBAOFST
 
.DVBASPCG(5)=5-DVBAOFST,DVBASPCG(6)=70-DVBAOFST
 
.S:(DVBACSRTDVBASPCG(7)=70-DVBAOFST,DVBASPCG(8)=91-DVBAOFST
 
.S:('DVBACSRTDVBASPCG(7)=101,DVBASPCG(8)=121
 
Q
 
;
 ;Input  DVBARIEN - IEN of Request (396.3) associated with Exam
 ;       DVBACNDE - CNTRCTR Node for Exam IEN in 396.4
 ;       DVBAGLBL - Global Reference for Requests Counted
 ;       DVBARSLTS - Global Reference for results
 ;Output Global Array Entries Updated for Contractor if applicable
 ;       ^TMP($J,"DVBATRPTS") / ^TMP("DVBATRSLTS",$J)
SRPTS(DVBARIEN,DVBACNDE,DVBAGLBL,DVBARSLTS) ;Summary Report Processing
 
DVBACNTR,DVBACNME
 
DVBACNME=$P($G(^DVB(396.45,+$P(DVBACNDE,"^"),0)),"^")
 
;Retrieve current number of exams referred by contractor
 
DVBACNTR=$P($G(@DVBARSLTS@(DVBACNME,+$P(DVBACNDE,"^"))),"^",3)
 
;Increment Number of Exams referred for contractor
 
S $P(@DVBARSLTS@(DVBACNME,+$P(DVBACNDE,"^")),"^",3)=DVBACNTR+1
 
;Increment 2507 Request Counter if IEN NOT already counted for Contractor
 
D:('$D(@DVBAGLBL@(+$P(DVBACNDE,"^"),DVBARIEN)))
 .
@DVBAGLBL@(+$P(DVBACNDE,"^"),DVBARIEN)=""  ;Add request IEN to list
 
.DVBACNTR=$P($G(@DVBARSLTS@(DVBACNME,+$P(DVBACNDE,"^"))),"^",4)
 .
;Increment # of 2507 Request referred to contractor
 
.S $P(@DVBARSLTS@(DVBACNME,+$P(DVBACNDE,"^")),"^",4)=DVBACNTR+1
 
Q
 
;
 ;Input  DVBACNDE - CNTRCTR Node for Exam IEN in 396.4
 ;       DVBAGLBL - Global Reference for Timeliness counters
 ;       DVBARSLTS - Global Reference for results
 ;Output Global Array Entries Updated for Contractor if applicable
 ;       ^TMP($J,"DVBATRPTS") / ^TMP("DVBATRSLTS",$J)
TRPTS(DVBACNDE,DVBAGLBL,DVBARSLTS,DVBATVAL) ;Timeliness Report Processing
 
DVBACNME,DVBANDAYS,DVBANEXMS
 
;Ignore Exams NOT returned (Checked-In) by Contractor
 
DVBANDAYS=+$G(@DVBAGLBL@(+$P(DVBACNDE,"^"),"DAYS"))
 
DVBANEXMS=+$G(@DVBAGLBL@(+$P(DVBACNDE,"^"),"EXMS"))
 
;Increment Timeliness Counter (Total # of Days)
 
@DVBAGLBL@(+$P(DVBACNDE,"^"),"DAYS")=DVBANDAYS+DVBATVAL
 
;Increment Number of Exams Found
 
@DVBAGLBL@(+$P(DVBACNDE,"^"),"EXMS")=DVBANEXMS+1
 
DVBACNME=$P($G(^DVB(396.45,+$P(DVBACNDE,"^"),0)),"^")
 
;Update Average Timeliness result for Contractor
 
S $P(@DVBARSLTS@(DVBACNME,+$P(DVBACNDE,"^")),"^",3)=$FN((DVBANDAYS+DVBATVAL)/(DVBANEXMS+1),"",0)
 
Q
 
;
TRPTS2(DVBACNDE) ;Timeliness include logic
 
DVBACNME,DVBATVAL,DVBANDAYS,DVBANEXMS,X1,X2,X,%Y
 
DVBAEXM2,STAT
 
^TMP($J,"DVBACER1.FLAG")
 
GETS^DIQ(396.4,DVBAEIEN_",",".03;.04;100;101;102","EI","DVBAEXM2")
 
STAT=$G(DVBAEXM2(396.4,DVBAEIEN_",",.04,"I"))
 
CNTR=$G(DVBAEXM2(396.4,DVBAEIEN_",",100,"I")) S:$G(CNTR)="" CNTR="X"
 
X1=$P(DVBACNDE,"^",3),X2=$P(DVBACNDE,"^",2) ^%DTC
 
I $P(DVBACNDE,"^",3)="" ^TMP($J,"DVBACER1.FLAG",CNTR)=1
 
DVBATVAL=X  ;# Days between CheckIn and CheckOut
 
S:DVBATVAL="" DVBATVAL=0
 
^TMP($J,"DVBACER1",CNTR,DVBATVAL)=DVBACNDE_"|"_STAT
 
Q
 
;
TRPTS3(DVBAGLBL,DVBARSLTS) ;Timeliness calculation section
 
Q:'$D(^TMP($J,"DVBACER1"))
 
OPENEXM,CNTR,DVBATVAL
 
CNTR="" F  S CNTR=$O(^TMP($J,"DVBACER1",CNTR)) Q:CNTR=""  D
 
.Q:CNTR="X"
 
.Q:$G(^TMP($J,"DVBACER1.FLAG",CNTR))=1
 .
OPENEXM(CNTR)=0
 .
DVBATVAL="" F  S DVBATVAL=$O(^TMP($J,"DVBACER1",CNTR,DVBATVAL)) Q:DVBATVAL=""!(OPENEXM(CNTR)=1)  D
 
..I $P(^TMP($J,"DVBACER1",CNTR,DVBATVAL),"|",2)'="C" OPENEXM(CNTR)=1 Q
 S 
CNTR="" F  S CNTR=$O(OPENEXM(CNTR)) Q:CNTR=""  D
 
.Q:OPENEXM(CNTR)=1
 .
DVBATVAL=$O(^TMP($J,"DVBACER1",CNTR,""),-1),DVBACNDE=$P(^TMP($J,"DVBACER1",CNTR,DVBATVAL),"|",1) 
 
..Q:DVBATVAL=0
 ..
TRPTS(DVBACNDE,DVBAGLBL,DVBARSLTS,DVBATVAL)
 
^TMP($J,"DVBACER1")
 
^TMP($J,"DVBACER1.FLAG")
 
;
GETHFS() ;Get HFS File Name
 
DVBAH
 
DVBAH=$H
 Q 
"DVBA_"_$J_"_"_$P(DVBAH,",")_"_"_$P(DVBAH,",",2)_".DAT"
 ;
OPENHFS(DVBAHNDL,DVBAHFS,DVBAMODE,DVBARSLTS) ;Open HFS File
 
DVBAERR,POP
 
DVBAERR=0
 
OPEN^%ZISH(DVBAHNDL,,DVBAHFS,$G(DVBAMODE,"W")) D:POP  Q:POP
 
.DVBAERR=1,@DVBARSLTS@(1)="0^Unable to open HFS file."
 
DVBAERR
 
;
CLOSEHFS(DVBAHNDL,DVBAHFS,DVBARSLTS) ;Close HFS and unload data
 
DVBADEL,X,%ZIS
 
CLOSE^%ZISH(DVBAHNDL)
 
DVBADEL(DVBAHFS)=""
 
X=$$FTG^%ZISH(,DVBAHFS,$NA(@DVBARSLTS@(1)),4)
 
X=$$DEL^%ZISH(,$NA(DVBADEL))
 
Q
 
;