DVBARSBD ;ALB/RPM - CAPRI 2507 REQUEST STATUS BY DT RANGE REPORT ; 01/24/12
;;2.7;AMIE;**179,185,189,190,192,193**;Apr 10, 1995;Build 84
;
Q ;NO DIRECT ENTRY
;
REQSTAT(DVBSDAT,DVBEDAT,DVBRSTAT,DVBDELIM,DVBNODT) ;entry for request status by dt range
;
; Input:
; DVBSDAT - start date (FM format)
; DVBEDAT - end date (FM format)
; DVBRSTAT - request status (internal format)
; DVBDELIM - return delimited results (0=no;1=yes)
; DVBNODT - ignore date range (0=no;1=yes)
;
N EXSTAT ;request status (external format)
N EXSDAT ;start date (external format: MM/DD/YYYY)
N EXEDAT ;end date (external format: MM/DD/YYYY)
N DVBARS ;request status conversion results
N DVBERR ;FM error msg
N DVBCNT ;returned record count
;GRE- 193 ;Request Status conversion Report changes ;
N RRIENINC ; re-route ien counter
N RRDATE ;re-route date
N RRTOSITE ;re-route to site
N RRFRMSITE ; re-route from site;
N RRSTATINC ; re-route status counter
N RRSTATDTE ; re-route status date
N RRSTAT ; re-route status
N DVBLINE ;header separator
;GRE ; end Request Status conversion Report changes ;
K ^TMP("DVBREQ",$J),^TMP("DVBREQN",$J)
S EXSDAT=$$FMTE^XLFDT(DVBSDAT,"5DZ")
S EXEDAT=$$FMTE^XLFDT(DVBEDAT,"5DZ")
S (RRDATE,RRFRMSITE,RRTOSITE,RRSTATDTE,RRSTAT)="",(RRIENINC,RRSTATINC)=0
S $P(DVBLINE,"-",131)=""
I DVBRSTAT="RN" S DVBRSTAT="NR"
I DVBRSTAT="A" S EXSTAT="ALL"
E D
. D CHK^DIE(396.3,17,"E",DVBRSTAT,.DVBARS,"DVBERR")
. S EXSTAT=$G(DVBARS(0))
S DVBCNT=1
S DVBAD=$S(DVBDELIM=1:",",1:0)
;
;collect records matching search criteria
I DVBNODT D
. S EXSDAT="NO START DATE"
. S EXEDAT="NO END DATE"
. I DVBDELIM D DELIMHDR(EXSDAT,EXEDAT,EXSTAT)
. D GETRECSN(DVBRSTAT,.DVBCNT)
E D
. I DVBDELIM D DELIMHDR(EXSDAT,EXEDAT,EXSTAT)
. D GETRECS(DVBSDAT,DVBEDAT,DVBRSTAT,.DVBCNT)
D I 'DVBCNT D
. W "NO DATA FOUND"
E D
. I 'DVBDELIM D PLAINHDR(EXSDAT,EXEDAT,EXSTAT),PLAIN ;plain text format
. I DVBDELIM D DELIM ;comma delimited format
;
END ;Clean up local variables
K DIWF,DIWL,DIWR,DVBAD,DVBAX,DVBAY,DVBCNRS,DVBEXAM,DVBIEN4,DVBI2,DVBX,DVBXCNT,LINE,X
K DVBAD,DVBAX,DVBAY,DVBCT,DVBCTN,DVBCTW,DVBIEN4,DVBI2,DIWF,DIWL,DIWR,DVBX,DVBSC,DVBSCC,DVBSCN,DVBSCW,DVBSCWA,DVBXCNT,LINE,X
K DVBSCNS,DVBAA,^TMP("DVBREQ",$J),^TMP("DVBREQH",$J)
K DVBREQH,DVBREQL2,DVBREQL3,DVBI22,MSG,RCC,RCR,RRFRMSITE
Q
;
GETRECS(SDAT,EDAT,RSTAT,CNT) ;collect 2507 REQUEST record matches, when DVBNODT=0 means not ignoring the date range
;This procedure collects all 2507 REQUEST records that have a
;DATE STATUS LAST CHANGED within the start and end dates and have
;a REQUEST STATUS that matches the input request status parameter.
;
; Input:
; SDAT - start date (FM format)
; EDAT - end date (FM format)
; RSTAT - request status (internal format)
; CNT - record count (passed by reference)
;
N CHGDAT ;change date
N DVBIEN ;2507 REQUEST IEN
N DVBSTAT ;2507 REQUEST STATUS
N FLD ;field array in external format
S CHGDAT=SDAT-1
S DVBIEN=0,CNT=0 F S CHGDAT=$O(^DVB(396.3,"AH",CHGDAT)) Q:'CHGDAT!(CHGDAT>EDAT) D
. F S DVBIEN=$O(^DVB(396.3,"AH",CHGDAT,DVBIEN)) Q:'DVBIEN D
. . ;AJF; Request Status Conversion
. . S DVBSTAT=$$RSTAT^DVBCUTL8($P(^DVB(396.3,DVBIEN,0),U,18))
. . I RSTAT="A"!(DVBSTAT=RSTAT) D
. . . K FLD
. . . I $$SETFLDS(DVBIEN,.FLD) D
. . . . S CNT=CNT+1,DVBXCNT=1
. . . . I $G(DVBAD)'="," S ^TMP("DVBREQX",$J,CNT)=FLD("IEN")_U_FLD("SS")_U_FLD("NM")_U_FLD("REQDT")_U_FLD("RELDT")_U_FLD("PRTDT")_U_FLD("RS")_U_FLD("CANDT")_U_FLD("RO")_U_FLD("CANRS",DVBXCNT)_U_FLD("CANCOM",DVBXCNT) D
. . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=FLD("IEN")_U_FLD("SS")_U_FLD("NM")_U_FLD("REQDT")_U_FLD("RELDT")_U_FLD("PRTDT")_U_FLD("RS")_U_FLD("CANDT")_U_FLD("RO")_U_FLD("CANRS",DVBXCNT)_U_FLD("CANCOM",DVBXCNT)_U
. . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=^TMP("DVBREQ",$J,CNT,DVBIEN)_FLD("DVBCTW")_U_FLD("DVBSCWA")_U_RRDATE_U_RRTOSITE_U_RRFRMSITE
. . . . . S CNT=CNT+1,DVBXCNT=DVBXCNT+1
. . . . I $G(DVBAD)="," D
. . . . . S (RCC,RCR)=""
. . . . . D:$D(FLD("IEN4",1)) CANFLD
. . . . . S FLD("CANRS")=RCR,FLD("CANCOM")=RCC
. . . . . S FLD("RRLOC")=$TR(FLD("RRLOC"),",",""),FLD("RRSTE")=$TR(FLD("RRSTE"),",","")
. . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=FLD("SS")_DVBAD_""""_FLD("NM")_""""_DVBAD_FLD("REQDT")_DVBAD_FLD("RELDT")_DVBAD_""""_FLD("PRTDT")_""""_DVBAD
. . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=^TMP("DVBREQ",$J,CNT,DVBIEN)_""""_FLD("RS")_""""_DVBAD_FLD("CANDT")_DVBAD_""""_FLD("RO")_""""_DVBAD
. . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=^TMP("DVBREQ",$J,CNT,DVBIEN)_""""_FLD("CANRS")_""""_DVBAD_FLD("CANCOM")_DVBAD_""""_FLD("DVBCTW")_""""_DVBAD
. . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=^TMP("DVBREQ",$J,CNT,DVBIEN)_""""_FLD("DVBSCWA")_""""_DVBAD_FLD("RRDTE")_DVBAD_""""_FLD("RRLOC")_""""_DVBAD
. . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=^TMP("DVBREQ",$J,CNT,DVBIEN)_""""_FLD("RRSTE")_""""_DVBAD
. . . . . S CNT=CNT+1
Q
CANFLD ;
N RS1,RC1,RRCR,RRCC
S DVBX=0
F S DVBX=$O(FLD("IEN4",DVBX)) Q:'DVBX D
. S RS1=FLD("CANRS",DVBX),RC1=FLD("CANCOM",DVBX)
. S RS1=$E(RS1,1,50),RC1=$E(RC1,1,50)
. I RS1'="",'$D(RRCR(RS1)) S RRCR(RS1)=""
. I RC1'="",'$D(RRCC(RC1)) S RRCC(RC1)=""
S (RCR,RS1)="" F S RS1=$O(RRCR(RS1)) Q:RS1="" S RCR=$S(RCR="":RS1,1:RCR_"^"_RS1)
S (RCC,RC1)="" F S RC1=$O(RRCC(RC1)) Q:RC1="" S RCC=$S(RCC="":RC1,1:RCC_"^"_RC1)
S RCC=$TR(RCC,",","")
I $L(RCR)>40 S RCR="*"_$E(RCR,1,40)
I $L(RCC)>40 S RCC="*"_$E(RCC,1,40)
Q
;
SETFLDS(DVBIEN,DVBFLDS) ;build field array in external format
;This function formats the collected record data in external format
;and returns the results TRUE and an array on success. Otherwise,
;the function returns FALSE.
;
; Integration Reference #10061 - DEM^VADPT
;
; Input:
; DVBIEN - 2507 REQUEST IEN
; DVBFLDS - field array passed by reference
;
; Output:
; DVBFLDS("IEN") - 2507 REQUEST IEN
; DVBFLDS("NM") - patient name
; DVBFLDS("SS") - social security number
; DVBFLDS("RS") - request status
; DVBFLDS("REQDT") - request date
; DVBFLDS("RELDT") - release date
; DVBFLDS("PRTDT") - print date
; DVBFLDS("CANDT") - canceled date
; DVBFLDS("RO") - regional office
; DVBFLDS("IREQDT") - request date in internal FM format
; DVBFLDS("EXAM") - added with patch DVB*2.7*189; HOLDS THE 2507 EXAM name
; DVBFLDS("CANRS") - added with patch DVB*2.7*189; HOLDS THE 2507 EXAM CANCELLATION REASON name
; DVBFLDS("CANCOM") - added with patch DVB*2.7*189; HOLDS THE 2507 EXAM CANCELLATION COMMENTS name
;GRE add re-route fields
; DVBFLDS("RRDATE") - added with patch DVBA*2.7*193 holds the 2507 Re-Route Date
; DVBFLDS("RRSITE") - added with patch DVBA*2.7*193 holds the 2507 Re-Route Site
; DVBFLDS("RRLOC") - added with patch DVBA*2.7*193 holds the 2507 Re-Route Location
; Function Result - return 1 on success; otherwise returns 0
;
N DFN ;PATIENT file IEN used in VADPT call
N DVBDAT ;2507 REQUEST data field array
N DVBIENS ;FM IENS value
N DVBRSLT ;function result
N VADM ;VADPT return array
N DVBIEN4 ;the IEN FROM 2507 EXAM FILE 396.4
N DVBALAST ;number of lines in the wp cancellation comments
N DVBAI ;for loop index
N DVBAX ;
K DVBFLDS
S (RRDATE,RRFRMSITE,RRTOSITE)=""
S DVBRSLT=0
S DVBIENS=+$G(DVBIEN)_","
D GETS^DIQ(396.3,DVBIENS,".01;1;2;13;15;17;19","IE","DVBDAT","")
S DFN=$G(DVBDAT(396.3,DVBIENS,.01,"I"))
D DEM^VADPT
I $G(VADM(1))'="" D ;only return record when name is resolved
. S DVBFLDS("IEN")=DVBIEN
. S DVBFLDS("NM")=$G(VADM(1))
. S DVBFLDS("SS")=$S(DVBDELIM:$P($G(VADM(2)),U,2),1:$P($G(VADM(2)),U,1))
. S DVBFLDS("RS")=$G(DVBDAT(396.3,DVBIENS,17,"E"))
. S DVBFLDS("REQDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,1,"I")),"5DZ")
. S DVBFLDS("RELDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,13,"I")),"5DZ")
. S DVBFLDS("PRTDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,15,"I")),"5DZ")
. S DVBFLDS("CANDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,19,"I")),"5DZ")
. S DVBFLDS("RO")=$G(DVBDAT(396.3,DVBIENS,2,"E"))
. D CLAIMTYP,SPEC,GETRRDAT
. S DVBFLDS("DVBCTW")=DVBCTW
. S DVBFLDS("DVBSCWA")=DVBSCWA
. S DVBFLDS("RRDTE")=RRDATE
. S DVBFLDS("RRSTE")=RRFRMSITE
. S DVBFLDS("RRLOC")=RRTOSITE
. S DVBXCNT=1
. S (DVBFLDS("CANRS",DVBXCNT),DVBFLDS("CANCOM",DVBXCNT),DVBFLDS("IEN4"))=""
. S DVBIEN4=0 F S DVBIEN4=$O(^DVB(396.4,"C",DVBIEN,DVBIEN4)) Q:'DVBIEN4 D
. . I $D(^DVB(396.4,DVBIEN4,"CAN")) D
. . . S DVBAY=($P($P(^DVB(396.4,DVBIEN4,"CAN"),"^",1),".",1)) I DVBAY>(DVBSDAT-1)&DVBAY<(DVBEDAT+1) D
. . . . S DVBFLDS("CANRS",DVBXCNT)=$$GET1^DIQ(396.4,DVBIEN4,52)
. . . . I $D(^DVB(396.4,DVBIEN4,5)) D
. . . . . S DVBFLDS("IEN4",DVBXCNT)=DVBIEN4
. . . . . K WP S DVBAX=$$GET1^DIQ(396.4,DVBIEN4,53,"Z","WP") ; this puts the wordprocessing field into an array 'WP(#,0)=' next it gets put into one entry of the DVBFLDS ARRAY so we can handle any comma's that aren't delimiters
. . . . . ;DVBALAST gets the number of WP lines to loop through in the for loop
. . . . . S DVBALAST=$P(^DVB(396.4,DVBIEN4,5,0),U,3) S DVBAI="",DVBFLDS("CANCOM",DVBXCNT)=WP(1,0)
. . . . . F DVBAI=1:1:DVBALAST S DVBFLDS("CANCOM",DVBXCNT)=DVBFLDS("CANCOM",DVBXCNT)_" "_WP(DVBAI,0) Q:$L(DVBFLDS("CANCOM",DVBXCNT))>150
. . . . . ;S DVBALAST=$P(^DVB(396.4,DVBIEN4,5,0),U,3) S DVBAI="" F DVBAI=1:1:DVBALAST S DVBFLDS("CANCOM",DVBAI)=WP(DVBAI,0)
. . . . . S DVBXCNT=DVBXCNT+1
. S DVBFLDS("IREQDT")=$G(DVBDAT(396.3,DVBIENS,1,"I"))
. S DVBRSLT=1
Q DVBRSLT
;
DELIMHDR(EXSDAT,EXEDAT,EXSTAT) ;output delimited format header
; Input:
; EXSDAT - start date (external format)
; EXEDAT - end date (external format)
; EXSTAT - request status (external format)
; GRE ; added re-route status information to the report
S ^TMP("DVBREQH",$J,DVBCNT)="Request Status by Date Range Report",DVBCNT=DVBCNT+1
S ^TMP("DVBREQH",$J,DVBCNT)="Date Range: "_EXSDAT_" - "_EXEDAT,DVBCNT=DVBCNT+1
S ^TMP("DVBREQH",$J,DVBCNT)=""""_"Request Status: "_EXSTAT_""""_$C(13),DVBCNT=DVBCNT+1
S ^TMP("DVBREQH",$J,DVBCNT)="SSN"_DVBAD_"PatientName"_DVBAD_"RequestDT"_DVBAD_"DTReleased"_DVBAD_"DTPrinted"_DVBAD_"RequestStatus"_DVBAD_"DtCanceled"_DVBAD_"Station"_DVBAD_"Cancellation Reason"_DVBAD_"Cancellation Comments"_DVBAD
S ^TMP("DVBREQH",$J,DVBCNT)=^TMP("DVBREQH",$J,DVBCNT)_"Claim Type"_DVBAD_"Special Consideration(s)"_DVBAD_"Re-Route Date"_DVBAD_"Re-Route To Site"_DVBAD_"Re-Route From Site",DVBCNT=DVBCNT+1
Q
;
DELIM ;output delimited format
;
N DVBI ;generic counter
N DVBREQ ;request record
;
U IO
S DVBI=0 F S DVBI=$O(^TMP("DVBREQH",$J,DVBI)) Q:'DVBI D
. S DVBREQH=^TMP("DVBREQH",$J,DVBI)
. W !,DVBREQH
S DVBI2=0 F S DVBI2=$O(^TMP("DVBREQ",$J,DVBI2)) Q:'DVBI2 D
. S DVBIEN=0 F S DVBIEN=$O(^TMP("DVBREQ",$J,DVBI2,DVBIEN)) Q:'DVBIEN D
. . S DVBREQL2=^TMP("DVBREQ",$J,DVBI2,DVBIEN)
. . W !,DVBREQL2
. . S DVBI22=0 F S DVBI22=$O(^TMP("DVBREQ",$J,DVBI2,DVBIEN,DVBI22)) Q:'DVBI22 D
. . . S DVBREQL3=^TMP("DVBREQ",$J,DVBI2,DVBIEN,DVBI22)
. . . W !,DVBREQL3
;
Q
;
PLAINHDR(EXSDAT,EXEDAT,EXSTAT) ;output plain text header
;Populate the header information.
;CAUTION: The CAPRI GUI pulls this information to populate the header
;for each page when creating a printed report. Do not modify the
;content or line count of the header information without validating
;against the CAPRI GUI interface.
;
;CAPRI GUI to populate
; Input:
; EXSDAT - start date (external format)
; EXEDAT - end date (external format)
; EXSTAT - request status (external format)
;
; N DVBLINE ;header separator
;
U IO
;S $P(DVBLINE,"-",131)=""
W !,"Date Range: "_EXSDAT_" - "_EXEDAT
W !,"Request Status: ",EXSTAT
W !,"-----------------------------------------------------------------------------------------------"
Q
;
PLAIN ;output plain text format
;Output formatted text format. The patient name and station nameC
;are truncated at 20 characters to maintain 132 character report.
;
N DVBI ;generic counter
N DVBREQ ;request record
U IO
S DVBI=0
F S DVBI=$O(^TMP("DVBREQ",$J,DVBI)) Q:'DVBI D
. S DVBIEN=0 F S DVBIEN=$O(^TMP("DVBREQ",$J,DVBI,DVBIEN)) Q:'DVBIEN D
. . S DVBREQ=^TMP("DVBREQ",$J,DVBI,DVBIEN)
. . D GETRRDAT
. . W !,DVBLINE
. . W !,"SSN:",?14,$P(DVBREQ,U,2)
. . W !,"PATIENT NAME:",?14,$E($P(DVBREQ,U,3),1,20)
. . W !,"REQUEST DT:",?14,$P(DVBREQ,U,4)
. . W !,"DT RELEASED:",?14,$P(DVBREQ,U,5)
. . W !,"DT PRINTED:",?14,$P(DVBREQ,U,6)
. . W !,"STATUS:",?14,$P(DVBREQ,U,7)
. . W !,"DT CANCELED:",?14,$P(DVBREQ,U,8)
. . D CLAIMTYP,SPEC
. . W !,"CLAIM TYPE: ",DVBCTW
. . W !,"SPECIAL CONSIDERATION(S):",DVBSCWA
. . W !,"RE-ROUTE DATE:",RRDATE
. . W !,"RE-ROUTE FROM SITE:",RRFRMSITE
. . W !,"RE-ROUTE TO SITE:",RRTOSITE
. . S DVBIEN4=0 F S DVBIEN4=$O(^DVB(396.4,"C",DVBIEN,DVBIEN4)) Q:'DVBIEN4 D
. . . I $D(^DVB(396.4,DVBIEN4,"CAN")) D
. . . . S DVBAY=($P($P(^DVB(396.4,DVBIEN4,"CAN"),"^",1),".",1)) I DVBAY>(DVBSDAT-1)&DVBAY<(DVBEDAT+1) D
. . . . . S DVBCNRS=$$GET1^DIQ(396.4,DVBIEN4,52) D
. . . . . I DVBCNRS'="" D W !,"CANCELLATION REASON:",?14,DVBCNRS
. . . . . .;W !,"CANCELLATION REASON:",?14,DVBCNRS
. . . . . I $D(^DVB(396.4,DVBIEN4,5)) D
. . . . . . K ^UTILITY($J,"W")
. . . . . . W !,"CANCELLATION COMMENTS:",?14 F LINE=0:0 S LINE=$O(^DVB(396.4,DVBIEN4,5,LINE)) Q:LINE="" S X=^(LINE,0),DIWL=5,DIWR=75,DIWF="NW" D ^DIWP
Q
;
GETRECSN(RSTAT,DVBCNT) ;collect 2507 REQUEST status matches and ignore date range
;This procedure collects all 2507 REQUEST records that have a REQUEST STATUS
;that matches the input request status parameter regardless of the LAST
;STATUS CHANGE DATE range. The procedure uses the "AF" index which sorts
;by REQUEST STATUS and REGIONAL OFFICE.
;
; Input:
; RSTAT - request status (internal format)
; DVBCNT - record count (passed by reference)
;
;
N DVBIEN ;2507 REQUEST IEN
N FLD ;field array in external format
N DVBRO ;regional office
S DVBRO=0,DVBCNT=0 F S DVBRO=$O(^DVB(396.3,"AF",RSTAT,DVBRO)) Q:'DVBRO D
. S DVBIEN=0
. F S DVBIEN=$O(^DVB(396.3,"AF",RSTAT,DVBRO,DVBIEN)) Q:'DVBIEN D
. . K FLD
. . I $$SETFLDS(DVBIEN,.FLD) D
. . . S DVBXCNT=1
. . . I $G(DVBAD)'="," D
. . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=FLD("IEN")_U_FLD("SS")_U_FLD("NM")_U_FLD("REQDT")_U_FLD("RELDT")_U_FLD("PRTDT")_U_FLD("RS")_U_FLD("CANDT")_U_FLD("RO")_U_FLD("CANRS",DVBXCNT)_U_FLD("CANCOM",DVBXCNT)_U
. . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=^TMP("DVBREQ",$J,DVBCNT,DVBIEN)_FLD("DVBCTW")_U_FLD("DVBSCWA")
. . . . S DVBCNT=DVBCNT+1,DVBXCNT=DVBXCNT+1
. . . I $G(DVBAD)="," D
. . . . S (RCC,RCR)=""
. . . . D:$D(FLD("IEN4",1)) CANFLD
. . . . S FLD("CANRS")=RCR,FLD("CANCOM")=RCC
. . . . S FLD("RRLOC")=$TR(FLD("RRLOC"),",",""),FLD("RRSTE")=$TR(FLD("RRSTE"),",","")
. . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=FLD("SS")_DVBAD_""""_FLD("NM")_""""_DVBAD_FLD("REQDT")_DVBAD_FLD("RELDT")_DVBAD_""""_FLD("PRTDT")_""""_DVBAD
. . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=^TMP("DVBREQ",$J,DVBCNT,DVBIEN)_""""_FLD("RS")_""""_DVBAD_FLD("CANDT")_DVBAD_""""_FLD("RO")_""""_DVBAD
. . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=^TMP("DVBREQ",$J,DVBCNT,DVBIEN)_""""_FLD("CANRS")_""""_DVBAD_FLD("CANCOM")_DVBAD_""""_FLD("DVBCTW")_""""_DVBAD
. . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=^TMP("DVBREQ",$J,DVBCNT,DVBIEN)_""""_FLD("DVBSCWA")_""""_DVBAD_FLD("RRDTE")_DVBAD_""""_FLD("RRSTE")_""""_DVBAD
. . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=^TMP("DVBREQ",$J,DVBCNT,DVBIEN)_""""_FLD("RRLOC")_""""_DVBAD
. . . . S DVBCNT=DVBCNT+1
;load output global with sorted list
S CHGDAT="",CNT=0 ;use "" because value could be zero ("0")
F S CHGDAT=$O(^TMP("DVBREQN",$J,CHGDAT)) Q:(CHGDAT="") D
. S DVBIEN=0
. F S DVBIEN=$O(^TMP("DVBREQN",$J,CHGDAT,DVBIEN)) Q:'DVBIEN D
. . S CNT=CNT+1
. . S ^TMP("DVBREQ",$J,CNT)=^TMP("DVBREQN",$J,CHGDAT,DVBIEN)
Q
;
CLAIMTYP ;THE CLAIM TYPE OF A 2507 REQUEST
S DVBCTW=""
Q:'$D(^DVB(396.3,DVBIEN,9,0))
;DVBIEN is the 2507 REQUEST FILE IEN
;DVBCTW is the string /name of the CLAIM TYPE
D GETS^DIQ(396.3,DVBIEN_",","9.1*","E","MSG","ERR")
S DVBCTW=$G(MSG("396.32","1,"_DVBIEN_",",".01","E"))
Q
;
SPEC ;SPECIAL CONSIDERATION(S) FOR A 2507 REQUEST
K DVBSCW
S DVBSCWA=""
N DVBX
;DVBIEN is the 2507 REQUEST FILE IEN
;DVBSC is a the SPECIAL CONSIDERATION entry for the 2507 REQUEST
;DVBSCN is the pointer number to the SPECIAL CONSIDERATION file 396.25
;DVBSCW is the string /name of the SPECIAL CONSIDERATION
Q:'$D(^DVB(396.3,DVBIEN,8,0))
S DVBAA=$P(^DVB(396.3,DVBIEN,8,0),U,4)
S (DVBSC,DVBCNT)=0 F S DVBSC=$O(^DVB(396.3,DVBIEN,8,DVBSC)) Q:'DVBSC D
.S DVBSCN=$P(^DVB(396.3,DVBIEN,8,DVBSC,0),U,1)
.S DVBSCW(DVBSC)=$G(^DVB(396.25,DVBSCN,0))
.S DVBCNT=DVBCNT+1
.I (DVBCNT'=DVBAA) S:$D(DVBSCW(DVBSC)) DVBSCW(DVBSC)=DVBSCW(DVBSC)_","
S DVBX="" F S DVBX=$O(DVBSCW(DVBX)) Q:'DVBX S DVBSCWA=DVBSCWA_DVBSCW(DVBX)
Q
;
GETRRDAT ;GRE Input=IEN , get re-route date, to and from site and re-route status
S (RRDATE,RRTOSITE,RRFRMSITE,RRSTATDTE)=""
Q:'$D(^DVB(396.3,DVBIEN,6,0))
; quit if no re-route data found
K RRIENINC,RRSTATINC,RRSTAT,RRDATE,RRTOSITE,RRFRMSITE,RRSTATDTE
S (RRIENINC,RRSTATINC)=0
F S RRIENINC=$O(^DVB(396.3,DVBIEN,6,RRIENINC)) Q:RRIENINC="B" D
. S RRFRMSITE=$$EXTERNAL^DILFD(396.34,.02,,$P(^DVB(396.3,DVBIEN,6,RRIENINC,0),U,4))
. S RRDATE=$$FMTE^XLFDT($P(^DVB(396.3,DVBIEN,6,RRIENINC,0),U,1),"5DZ")
. S RRTOSITE=$$EXTERNAL^DILFD(396.34,.02,,$P(^DVB(396.3,DVBIEN,6,RRIENINC,0),U,7))
. S RRSTATINC=0
. F S RRSTATINC=$O(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC)) Q:RRSTATINC="" D
. . Q:'$D(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC,0))
. . S RRSTATDTE=$$FMTE^XLFDT($P(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC,0),U,1),"5DZ")
. . S RRSTAT=$$EXTERNAL^DILFD(396.341,1,,$P(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC,0),U,2))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBARSBD 18048 printed Apr 09, 2024@20:55:59 Page 2
DVBARSBD ;ALB/RPM - CAPRI 2507 REQUEST STATUS BY DT RANGE REPORT ; 01/24/12
+1 ;;2.7;AMIE;**179,185,189,190,192,193**;Apr 10, 1995;Build 84
+2 ;
+3 ;NO DIRECT ENTRY
QUIT
+4 ;
REQSTAT(DVBSDAT,DVBEDAT,DVBRSTAT,DVBDELIM,DVBNODT) ;entry for request status by dt range
+1 ;
+2 ; Input:
+3 ; DVBSDAT - start date (FM format)
+4 ; DVBEDAT - end date (FM format)
+5 ; DVBRSTAT - request status (internal format)
+6 ; DVBDELIM - return delimited results (0=no;1=yes)
+7 ; DVBNODT - ignore date range (0=no;1=yes)
+8 ;
+9 ;request status (external format)
NEW EXSTAT
+10 ;start date (external format: MM/DD/YYYY)
NEW EXSDAT
+11 ;end date (external format: MM/DD/YYYY)
NEW EXEDAT
+12 ;request status conversion results
NEW DVBARS
+13 ;FM error msg
NEW DVBERR
+14 ;returned record count
NEW DVBCNT
+15 ;GRE- 193 ;Request Status conversion Report changes ;
+16 ; re-route ien counter
NEW RRIENINC
+17 ;re-route date
NEW RRDATE
+18 ;re-route to site
NEW RRTOSITE
+19 ; re-route from site;
NEW RRFRMSITE
+20 ; re-route status counter
NEW RRSTATINC
+21 ; re-route status date
NEW RRSTATDTE
+22 ; re-route status
NEW RRSTAT
+23 ;header separator
NEW DVBLINE
+24 ;GRE ; end Request Status conversion Report changes ;
+25 KILL ^TMP("DVBREQ",$JOB),^TMP("DVBREQN",$JOB)
+26 SET EXSDAT=$$FMTE^XLFDT(DVBSDAT,"5DZ")
+27 SET EXEDAT=$$FMTE^XLFDT(DVBEDAT,"5DZ")
+28 SET (RRDATE,RRFRMSITE,RRTOSITE,RRSTATDTE,RRSTAT)=""
SET (RRIENINC,RRSTATINC)=0
+29 SET $PIECE(DVBLINE,"-",131)=""
+30 IF DVBRSTAT="RN"
SET DVBRSTAT="NR"
+31 IF DVBRSTAT="A"
SET EXSTAT="ALL"
+32 IF '$TEST
Begin DoDot:1
+33 DO CHK^DIE(396.3,17,"E",DVBRSTAT,.DVBARS,"DVBERR")
+34 SET EXSTAT=$GET(DVBARS(0))
End DoDot:1
+35 SET DVBCNT=1
+36 SET DVBAD=$SELECT(DVBDELIM=1:",",1:0)
+37 ;
+38 ;collect records matching search criteria
+39 IF DVBNODT
Begin DoDot:1
+40 SET EXSDAT="NO START DATE"
+41 SET EXEDAT="NO END DATE"
+42 IF DVBDELIM
DO DELIMHDR(EXSDAT,EXEDAT,EXSTAT)
+43 DO GETRECSN(DVBRSTAT,.DVBCNT)
End DoDot:1
+44 IF '$TEST
Begin DoDot:1
+45 IF DVBDELIM
DO DELIMHDR(EXSDAT,EXEDAT,EXSTAT)
+46 DO GETRECS(DVBSDAT,DVBEDAT,DVBRSTAT,.DVBCNT)
End DoDot:1
D IF 'DVBCNT
Begin DoDot:1
+1 WRITE "NO DATA FOUND"
End DoDot:1
+2 IF '$TEST
Begin DoDot:1
+3 ;plain text format
IF 'DVBDELIM
DO PLAINHDR(EXSDAT,EXEDAT,EXSTAT)
DO PLAIN
+4 ;comma delimited format
IF DVBDELIM
DO DELIM
End DoDot:1
+5 ;
END ;Clean up local variables
+1 KILL DIWF,DIWL,DIWR,DVBAD,DVBAX,DVBAY,DVBCNRS,DVBEXAM,DVBIEN4,DVBI2,DVBX,DVBXCNT,LINE,X
+2 KILL DVBAD,DVBAX,DVBAY,DVBCT,DVBCTN,DVBCTW,DVBIEN4,DVBI2,DIWF,DIWL,DIWR,DVBX,DVBSC,DVBSCC,DVBSCN,DVBSCW,DVBSCWA,DVBXCNT,LINE,X
+3 KILL DVBSCNS,DVBAA,^TMP("DVBREQ",$JOB),^TMP("DVBREQH",$JOB)
+4 KILL DVBREQH,DVBREQL2,DVBREQL3,DVBI22,MSG,RCC,RCR,RRFRMSITE
+5 QUIT
+6 ;
GETRECS(SDAT,EDAT,RSTAT,CNT) ;collect 2507 REQUEST record matches, when DVBNODT=0 means not ignoring the date range
+1 ;This procedure collects all 2507 REQUEST records that have a
+2 ;DATE STATUS LAST CHANGED within the start and end dates and have
+3 ;a REQUEST STATUS that matches the input request status parameter.
+4 ;
+5 ; Input:
+6 ; SDAT - start date (FM format)
+7 ; EDAT - end date (FM format)
+8 ; RSTAT - request status (internal format)
+9 ; CNT - record count (passed by reference)
+10 ;
+11 ;change date
NEW CHGDAT
+12 ;2507 REQUEST IEN
NEW DVBIEN
+13 ;2507 REQUEST STATUS
NEW DVBSTAT
+14 ;field array in external format
NEW FLD
+15 SET CHGDAT=SDAT-1
+16 SET DVBIEN=0
SET CNT=0
FOR
SET CHGDAT=$ORDER(^DVB(396.3,"AH",CHGDAT))
if 'CHGDAT!(CHGDAT>EDAT)
QUIT
Begin DoDot:1
+17 FOR
SET DVBIEN=$ORDER(^DVB(396.3,"AH",CHGDAT,DVBIEN))
if 'DVBIEN
QUIT
Begin DoDot:2
+18 ;AJF; Request Status Conversion
+19 SET DVBSTAT=$$RSTAT^DVBCUTL8($PIECE(^DVB(396.3,DVBIEN,0),U,18))
+20 IF RSTAT="A"!(DVBSTAT=RSTAT)
Begin DoDot:3
+21 KILL FLD
+22 IF $$SETFLDS(DVBIEN,.FLD)
Begin DoDot:4
+23 SET CNT=CNT+1
SET DVBXCNT=1
+24 IF $GET(DVBAD)'=","
SET ^TMP("DVBREQX",$JOB,CNT)=FLD("IEN")_U_FLD("SS")_U_FLD("NM")_U_FLD("REQDT")_U_FLD("RELDT")_U_FLD("PRTDT")_U_FLD("RS")_U_FLD("CANDT")_U_FLD("RO")_U_FLD("CANRS",DVBXCNT)_U_FLD("CANCOM",DVBXCNT)
Begin DoDot:5
+25 SET ^TMP("DVBREQ",$JOB,CNT,DVBIEN)=FLD("IEN")_U_FLD("SS")_U_FLD("NM")_U_FLD("REQDT")_U_FLD("RELDT")_U_FLD("PRTDT")_U_FLD("RS")_U_FLD("CANDT")_U_FLD("RO")_U_FLD("CANRS",DVBXCNT)_U_FLD("CANCOM",DVBXCNT)_U
+26 SET ^TMP("DVBREQ",$JOB,CNT,DVBIEN)=^TMP("DVBREQ",$JOB,CNT,DVBIEN)_FLD("DVBCTW")_U_FLD("DVBSCWA")_U_RRDATE_U_RRTOSITE_U_RRFRMSITE
+27 SET CNT=CNT+1
SET DVBXCNT=DVBXCNT+1
End DoDot:5
+28 IF $GET(DVBAD)=","
Begin DoDot:5
+29 SET (RCC,RCR)=""
+30 if $DATA(FLD("IEN4",1))
DO CANFLD
+31 SET FLD("CANRS")=RCR
SET FLD("CANCOM")=RCC
+32 SET FLD("RRLOC")=$TRANSLATE(FLD("RRLOC"),",","")
SET FLD("RRSTE")=$TRANSLATE(FLD("RRSTE"),",","")
+33 SET ^TMP("DVBREQ",$JOB,CNT,DVBIEN)=FLD("SS")_DVBAD_""""_FLD("NM")_""""_DVBAD_FLD("REQDT")_DVBAD_FLD("RELDT")_DVBAD_""""_FLD("PRTDT")_""""_DVBAD
+34 SET ^TMP("DVBREQ",$JOB,CNT,DVBIEN)=^TMP("DVBREQ",$JOB,CNT,DVBIEN)_""""_FLD("RS")_""""_DVBAD_FLD("CANDT")_DVBAD_""""_FLD("RO")_""""_DVBAD
+35 SET ^TMP("DVBREQ",$JOB,CNT,DVBIEN)=^TMP("DVBREQ",$JOB,CNT,DVBIEN)_""""_FLD("CANRS")_""""_DVBAD_FLD("CANCOM")_DVBAD_""""_FLD("DVBCTW")_""""_DVBAD
+36 SET ^TMP("DVBREQ",$JOB,CNT,DVBIEN)=^TMP("DVBREQ",$JOB,CNT,DVBIEN)_""""_FLD("DVBSCWA")_""""_DVBAD_FLD("RRDTE")_DVBAD_""""_FLD("RRLOC")_""""_DVBAD
+37 SET ^TMP("DVBREQ",$JOB,CNT,DVBIEN)=^TMP("DVBREQ",$JOB,CNT,DVBIEN)_""""_FLD("RRSTE")_""""_DVBAD
+38 SET CNT=CNT+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+39 QUIT
CANFLD ;
+1 NEW RS1,RC1,RRCR,RRCC
+2 SET DVBX=0
+3 FOR
SET DVBX=$ORDER(FLD("IEN4",DVBX))
if 'DVBX
QUIT
Begin DoDot:1
+4 SET RS1=FLD("CANRS",DVBX)
SET RC1=FLD("CANCOM",DVBX)
+5 SET RS1=$EXTRACT(RS1,1,50)
SET RC1=$EXTRACT(RC1,1,50)
+6 IF RS1'=""
IF '$DATA(RRCR(RS1))
SET RRCR(RS1)=""
+7 IF RC1'=""
IF '$DATA(RRCC(RC1))
SET RRCC(RC1)=""
End DoDot:1
+8 SET (RCR,RS1)=""
FOR
SET RS1=$ORDER(RRCR(RS1))
if RS1=""
QUIT
SET RCR=$SELECT(RCR="":RS1,1:RCR_"^"_RS1)
+9 SET (RCC,RC1)=""
FOR
SET RC1=$ORDER(RRCC(RC1))
if RC1=""
QUIT
SET RCC=$SELECT(RCC="":RC1,1:RCC_"^"_RC1)
+10 SET RCC=$TRANSLATE(RCC,",","")
+11 IF $LENGTH(RCR)>40
SET RCR="*"_$EXTRACT(RCR,1,40)
+12 IF $LENGTH(RCC)>40
SET RCC="*"_$EXTRACT(RCC,1,40)
+13 QUIT
+14 ;
SETFLDS(DVBIEN,DVBFLDS) ;build field array in external format
+1 ;This function formats the collected record data in external format
+2 ;and returns the results TRUE and an array on success. Otherwise,
+3 ;the function returns FALSE.
+4 ;
+5 ; Integration Reference #10061 - DEM^VADPT
+6 ;
+7 ; Input:
+8 ; DVBIEN - 2507 REQUEST IEN
+9 ; DVBFLDS - field array passed by reference
+10 ;
+11 ; Output:
+12 ; DVBFLDS("IEN") - 2507 REQUEST IEN
+13 ; DVBFLDS("NM") - patient name
+14 ; DVBFLDS("SS") - social security number
+15 ; DVBFLDS("RS") - request status
+16 ; DVBFLDS("REQDT") - request date
+17 ; DVBFLDS("RELDT") - release date
+18 ; DVBFLDS("PRTDT") - print date
+19 ; DVBFLDS("CANDT") - canceled date
+20 ; DVBFLDS("RO") - regional office
+21 ; DVBFLDS("IREQDT") - request date in internal FM format
+22 ; DVBFLDS("EXAM") - added with patch DVB*2.7*189; HOLDS THE 2507 EXAM name
+23 ; DVBFLDS("CANRS") - added with patch DVB*2.7*189; HOLDS THE 2507 EXAM CANCELLATION REASON name
+24 ; DVBFLDS("CANCOM") - added with patch DVB*2.7*189; HOLDS THE 2507 EXAM CANCELLATION COMMENTS name
+25 ;GRE add re-route fields
+26 ; DVBFLDS("RRDATE") - added with patch DVBA*2.7*193 holds the 2507 Re-Route Date
+27 ; DVBFLDS("RRSITE") - added with patch DVBA*2.7*193 holds the 2507 Re-Route Site
+28 ; DVBFLDS("RRLOC") - added with patch DVBA*2.7*193 holds the 2507 Re-Route Location
+29 ; Function Result - return 1 on success; otherwise returns 0
+30 ;
+31 ;PATIENT file IEN used in VADPT call
NEW DFN
+32 ;2507 REQUEST data field array
NEW DVBDAT
+33 ;FM IENS value
NEW DVBIENS
+34 ;function result
NEW DVBRSLT
+35 ;VADPT return array
NEW VADM
+36 ;the IEN FROM 2507 EXAM FILE 396.4
NEW DVBIEN4
+37 ;number of lines in the wp cancellation comments
NEW DVBALAST
+38 ;for loop index
NEW DVBAI
+39 ;
NEW DVBAX
+40 KILL DVBFLDS
+41 SET (RRDATE,RRFRMSITE,RRTOSITE)=""
+42 SET DVBRSLT=0
+43 SET DVBIENS=+$GET(DVBIEN)_","
+44 DO GETS^DIQ(396.3,DVBIENS,".01;1;2;13;15;17;19","IE","DVBDAT","")
+45 SET DFN=$GET(DVBDAT(396.3,DVBIENS,.01,"I"))
+46 DO DEM^VADPT
+47 ;only return record when name is resolved
IF $GET(VADM(1))'=""
Begin DoDot:1
+48 SET DVBFLDS("IEN")=DVBIEN
+49 SET DVBFLDS("NM")=$GET(VADM(1))
+50 SET DVBFLDS("SS")=$SELECT(DVBDELIM:$PIECE($GET(VADM(2)),U,2),1:$PIECE($GET(VADM(2)),U,1))
+51 SET DVBFLDS("RS")=$GET(DVBDAT(396.3,DVBIENS,17,"E"))
+52 SET DVBFLDS("REQDT")=$$FMTE^XLFDT($GET(DVBDAT(396.3,DVBIENS,1,"I")),"5DZ")
+53 SET DVBFLDS("RELDT")=$$FMTE^XLFDT($GET(DVBDAT(396.3,DVBIENS,13,"I")),"5DZ")
+54 SET DVBFLDS("PRTDT")=$$FMTE^XLFDT($GET(DVBDAT(396.3,DVBIENS,15,"I")),"5DZ")
+55 SET DVBFLDS("CANDT")=$$FMTE^XLFDT($GET(DVBDAT(396.3,DVBIENS,19,"I")),"5DZ")
+56 SET DVBFLDS("RO")=$GET(DVBDAT(396.3,DVBIENS,2,"E"))
+57 DO CLAIMTYP
DO SPEC
DO GETRRDAT
+58 SET DVBFLDS("DVBCTW")=DVBCTW
+59 SET DVBFLDS("DVBSCWA")=DVBSCWA
+60 SET DVBFLDS("RRDTE")=RRDATE
+61 SET DVBFLDS("RRSTE")=RRFRMSITE
+62 SET DVBFLDS("RRLOC")=RRTOSITE
+63 SET DVBXCNT=1
+64 SET (DVBFLDS("CANRS",DVBXCNT),DVBFLDS("CANCOM",DVBXCNT),DVBFLDS("IEN4"))=""
+65 SET DVBIEN4=0
FOR
SET DVBIEN4=$ORDER(^DVB(396.4,"C",DVBIEN,DVBIEN4))
if 'DVBIEN4
QUIT
Begin DoDot:2
+66 IF $DATA(^DVB(396.4,DVBIEN4,"CAN"))
Begin DoDot:3
+67 SET DVBAY=($PIECE($PIECE(^DVB(396.4,DVBIEN4,"CAN"),"^",1),".",1))
IF DVBAY>(DVBSDAT-1)&DVBAY<(DVBEDAT+1)
Begin DoDot:4
+68 SET DVBFLDS("CANRS",DVBXCNT)=$$GET1^DIQ(396.4,DVBIEN4,52)
+69 IF $DATA(^DVB(396.4,DVBIEN4,5))
Begin DoDot:5
+70 SET DVBFLDS("IEN4",DVBXCNT)=DVBIEN4
+71 ; this puts the wordprocessing field into an array 'WP(#,0)=' next it gets put into one entry of the DVBFLDS ARRAY so we can handle any comma's that aren't delimiters
KILL WP
SET DVBAX=$$GET1^DIQ(396.4,DVBIEN4,53,"Z","WP")
+72 ;DVBALAST gets the number of WP lines to loop through in the for loop
+73 SET DVBALAST=$PIECE(^DVB(396.4,DVBIEN4,5,0),U,3)
SET DVBAI=""
SET DVBFLDS("CANCOM",DVBXCNT)=WP(1,0)
+74 FOR DVBAI=1:1:DVBALAST
SET DVBFLDS("CANCOM",DVBXCNT)=DVBFLDS("CANCOM",DVBXCNT)_" "_WP(DVBAI,0)
if $LENGTH(DVBFLDS("CANCOM",DVBXCNT))>150
QUIT
+75 ;S DVBALAST=$P(^DVB(396.4,DVBIEN4,5,0),U,3) S DVBAI="" F DVBAI=1:1:DVBALAST S DVBFLDS("CANCOM",DVBAI)=WP(DVBAI,0)
+76 SET DVBXCNT=DVBXCNT+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+77 SET DVBFLDS("IREQDT")=$GET(DVBDAT(396.3,DVBIENS,1,"I"))
+78 SET DVBRSLT=1
End DoDot:1
+79 QUIT DVBRSLT
+80 ;
DELIMHDR(EXSDAT,EXEDAT,EXSTAT) ;output delimited format header
+1 ; Input:
+2 ; EXSDAT - start date (external format)
+3 ; EXEDAT - end date (external format)
+4 ; EXSTAT - request status (external format)
+5 ; GRE ; added re-route status information to the report
+6 SET ^TMP("DVBREQH",$JOB,DVBCNT)="Request Status by Date Range Report"
SET DVBCNT=DVBCNT+1
+7 SET ^TMP("DVBREQH",$JOB,DVBCNT)="Date Range: "_EXSDAT_" - "_EXEDAT
SET DVBCNT=DVBCNT+1
+8 SET ^TMP("DVBREQH",$JOB,DVBCNT)=""""_"Request Status: "_EXSTAT_""""_$CHAR(13)
SET DVBCNT=DVBCNT+1
+9 SET ^TMP("DVBREQH",$JOB,DVBCNT)="SSN"_DVBAD_"PatientName"_DVBAD_"RequestDT"_DVBAD_"DTReleased"_DVBAD_"DTPrinted"_DVBAD_"RequestStatus"_DVBAD_"DtCanceled"_DVBAD_"Station"_DVBAD_"Cancellation Reason"_DVBAD_"Cancellation Comments"_DVBAD
+10 SET ^TMP("DVBREQH",$JOB,DVBCNT)=^TMP("DVBREQH",$JOB,DVBCNT)_"Claim Type"_DVBAD_"Special Consideration(s)"_DVBAD_"Re-Route Date"_DVBAD_"Re-Route To Site"_DVBAD_"Re-Route From Site"
SET DVBCNT=DVBCNT+1
+11 QUIT
+12 ;
DELIM ;output delimited format
+1 ;
+2 ;generic counter
NEW DVBI
+3 ;request record
NEW DVBREQ
+4 ;
+5 USE IO
+6 SET DVBI=0
FOR
SET DVBI=$ORDER(^TMP("DVBREQH",$JOB,DVBI))
if 'DVBI
QUIT
Begin DoDot:1
+7 SET DVBREQH=^TMP("DVBREQH",$JOB,DVBI)
+8 WRITE !,DVBREQH
End DoDot:1
+9 SET DVBI2=0
FOR
SET DVBI2=$ORDER(^TMP("DVBREQ",$JOB,DVBI2))
if 'DVBI2
QUIT
Begin DoDot:1
+10 SET DVBIEN=0
FOR
SET DVBIEN=$ORDER(^TMP("DVBREQ",$JOB,DVBI2,DVBIEN))
if 'DVBIEN
QUIT
Begin DoDot:2
+11 SET DVBREQL2=^TMP("DVBREQ",$JOB,DVBI2,DVBIEN)
+12 WRITE !,DVBREQL2
+13 SET DVBI22=0
FOR
SET DVBI22=$ORDER(^TMP("DVBREQ",$JOB,DVBI2,DVBIEN,DVBI22))
if 'DVBI22
QUIT
Begin DoDot:3
+14 SET DVBREQL3=^TMP("DVBREQ",$JOB,DVBI2,DVBIEN,DVBI22)
+15 WRITE !,DVBREQL3
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 QUIT
+18 ;
PLAINHDR(EXSDAT,EXEDAT,EXSTAT) ;output plain text header
+1 ;Populate the header information.
+2 ;CAUTION: The CAPRI GUI pulls this information to populate the header
+3 ;for each page when creating a printed report. Do not modify the
+4 ;content or line count of the header information without validating
+5 ;against the CAPRI GUI interface.
+6 ;
+7 ;CAPRI GUI to populate
+8 ; Input:
+9 ; EXSDAT - start date (external format)
+10 ; EXEDAT - end date (external format)
+11 ; EXSTAT - request status (external format)
+12 ;
+13 ; N DVBLINE ;header separator
+14 ;
+15 USE IO
+16 ;S $P(DVBLINE,"-",131)=""
+17 WRITE !,"Date Range: "_EXSDAT_" - "_EXEDAT
+18 WRITE !,"Request Status: ",EXSTAT
+19 WRITE !,"-----------------------------------------------------------------------------------------------"
+20 QUIT
+21 ;
PLAIN ;output plain text format
+1 ;Output formatted text format. The patient name and station nameC
+2 ;are truncated at 20 characters to maintain 132 character report.
+3 ;
+4 ;generic counter
NEW DVBI
+5 ;request record
NEW DVBREQ
+6 USE IO
+7 SET DVBI=0
+8 FOR
SET DVBI=$ORDER(^TMP("DVBREQ",$JOB,DVBI))
if 'DVBI
QUIT
Begin DoDot:1
+9 SET DVBIEN=0
FOR
SET DVBIEN=$ORDER(^TMP("DVBREQ",$JOB,DVBI,DVBIEN))
if 'DVBIEN
QUIT
Begin DoDot:2
+10 SET DVBREQ=^TMP("DVBREQ",$JOB,DVBI,DVBIEN)
+11 DO GETRRDAT
+12 WRITE !,DVBLINE
+13 WRITE !,"SSN:",?14,$PIECE(DVBREQ,U,2)
+14 WRITE !,"PATIENT NAME:",?14,$EXTRACT($PIECE(DVBREQ,U,3),1,20)
+15 WRITE !,"REQUEST DT:",?14,$PIECE(DVBREQ,U,4)
+16 WRITE !,"DT RELEASED:",?14,$PIECE(DVBREQ,U,5)
+17 WRITE !,"DT PRINTED:",?14,$PIECE(DVBREQ,U,6)
+18 WRITE !,"STATUS:",?14,$PIECE(DVBREQ,U,7)
+19 WRITE !,"DT CANCELED:",?14,$PIECE(DVBREQ,U,8)
+20 DO CLAIMTYP
DO SPEC
+21 WRITE !,"CLAIM TYPE: ",DVBCTW
+22 WRITE !,"SPECIAL CONSIDERATION(S):",DVBSCWA
+23 WRITE !,"RE-ROUTE DATE:",RRDATE
+24 WRITE !,"RE-ROUTE FROM SITE:",RRFRMSITE
+25 WRITE !,"RE-ROUTE TO SITE:",RRTOSITE
+26 SET DVBIEN4=0
FOR
SET DVBIEN4=$ORDER(^DVB(396.4,"C",DVBIEN,DVBIEN4))
if 'DVBIEN4
QUIT
Begin DoDot:3
+27 IF $DATA(^DVB(396.4,DVBIEN4,"CAN"))
Begin DoDot:4
+28 SET DVBAY=($PIECE($PIECE(^DVB(396.4,DVBIEN4,"CAN"),"^",1),".",1))
IF DVBAY>(DVBSDAT-1)&DVBAY<(DVBEDAT+1)
Begin DoDot:5
+29 SET DVBCNRS=$$GET1^DIQ(396.4,DVBIEN4,52)
Begin DoDot:6
End DoDot:6
+30 IF DVBCNRS'=""
Begin DoDot:6
+31 ;W !,"CANCELLATION REASON:",?14,DVBCNRS
End DoDot:6
WRITE !,"CANCELLATION REASON:",?14,DVBCNRS
+32 IF $DATA(^DVB(396.4,DVBIEN4,5))
Begin DoDot:6
+33 KILL ^UTILITY($JOB,"W")
+34 WRITE !,"CANCELLATION COMMENTS:",?14
FOR LINE=0:0
SET LINE=$ORDER(^DVB(396.4,DVBIEN4,5,LINE))
if LINE=""
QUIT
SET X=^(LINE,0)
SET DIWL=5
SET DIWR=75
SET DIWF="NW"
DO ^DIWP
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
GETRECSN(RSTAT,DVBCNT) ;collect 2507 REQUEST status matches and ignore date range
+1 ;This procedure collects all 2507 REQUEST records that have a REQUEST STATUS
+2 ;that matches the input request status parameter regardless of the LAST
+3 ;STATUS CHANGE DATE range. The procedure uses the "AF" index which sorts
+4 ;by REQUEST STATUS and REGIONAL OFFICE.
+5 ;
+6 ; Input:
+7 ; RSTAT - request status (internal format)
+8 ; DVBCNT - record count (passed by reference)
+9 ;
+10 ;
+11 ;2507 REQUEST IEN
NEW DVBIEN
+12 ;field array in external format
NEW FLD
+13 ;regional office
NEW DVBRO
+14 SET DVBRO=0
SET DVBCNT=0
FOR
SET DVBRO=$ORDER(^DVB(396.3,"AF",RSTAT,DVBRO))
if 'DVBRO
QUIT
Begin DoDot:1
+15 SET DVBIEN=0
+16 FOR
SET DVBIEN=$ORDER(^DVB(396.3,"AF",RSTAT,DVBRO,DVBIEN))
if 'DVBIEN
QUIT
Begin DoDot:2
+17 KILL FLD
+18 IF $$SETFLDS(DVBIEN,.FLD)
Begin DoDot:3
+19 SET DVBXCNT=1
+20 IF $GET(DVBAD)'=","
Begin DoDot:4
+21 SET ^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)=FLD("IEN")_U_FLD("SS")_U_FLD("NM")_U_FLD("REQDT")_U_FLD("RELDT")_U_FLD("PRTDT")_U_FLD("RS")_U_FLD("CANDT")_U_FLD("RO")_U_FLD("CANRS",DVBXCNT)_U_FLD("CANCOM",DVBXCNT)_U
+22 SET ^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)=^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)_FLD("DVBCTW")_U_FLD("DVBSCWA")
+23 SET DVBCNT=DVBCNT+1
SET DVBXCNT=DVBXCNT+1
End DoDot:4
+24 IF $GET(DVBAD)=","
Begin DoDot:4
+25 SET (RCC,RCR)=""
+26 if $DATA(FLD("IEN4",1))
DO CANFLD
+27 SET FLD("CANRS")=RCR
SET FLD("CANCOM")=RCC
+28 SET FLD("RRLOC")=$TRANSLATE(FLD("RRLOC"),",","")
SET FLD("RRSTE")=$TRANSLATE(FLD("RRSTE"),",","")
+29 SET ^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)=FLD("SS")_DVBAD_""""_FLD("NM")_""""_DVBAD_FLD("REQDT")_DVBAD_FLD("RELDT")_DVBAD_""""_FLD("PRTDT")_""""_DVBAD
+30 SET ^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)=^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)_""""_FLD("RS")_""""_DVBAD_FLD("CANDT")_DVBAD_""""_FLD("RO")_""""_DVBAD
+31 SET ^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)=^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)_""""_FLD("CANRS")_""""_DVBAD_FLD("CANCOM")_DVBAD_""""_FLD("DVBCTW")_""""_DVBAD
+32 SET ^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)=^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)_""""_FLD("DVBSCWA")_""""_DVBAD_FLD("RRDTE")_DVBAD_""""_FLD("RRSTE")_""""_DVBAD
+33 SET ^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)=^TMP("DVBREQ",$JOB,DVBCNT,DVBIEN)_""""_FLD("RRLOC")_""""_DVBAD
+34 SET DVBCNT=DVBCNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;load output global with sorted list
+36 ;use "" because value could be zero ("0")
SET CHGDAT=""
SET CNT=0
+37 FOR
SET CHGDAT=$ORDER(^TMP("DVBREQN",$JOB,CHGDAT))
if (CHGDAT="")
QUIT
Begin DoDot:1
+38 SET DVBIEN=0
+39 FOR
SET DVBIEN=$ORDER(^TMP("DVBREQN",$JOB,CHGDAT,DVBIEN))
if 'DVBIEN
QUIT
Begin DoDot:2
+40 SET CNT=CNT+1
+41 SET ^TMP("DVBREQ",$JOB,CNT)=^TMP("DVBREQN",$JOB,CHGDAT,DVBIEN)
End DoDot:2
End DoDot:1
+42 QUIT
+43 ;
CLAIMTYP ;THE CLAIM TYPE OF A 2507 REQUEST
+1 SET DVBCTW=""
+2 if '$DATA(^DVB(396.3,DVBIEN,9,0))
QUIT
+3 ;DVBIEN is the 2507 REQUEST FILE IEN
+4 ;DVBCTW is the string /name of the CLAIM TYPE
+5 DO GETS^DIQ(396.3,DVBIEN_",","9.1*","E","MSG","ERR")
+6 SET DVBCTW=$GET(MSG("396.32","1,"_DVBIEN_",",".01","E"))
+7 QUIT
+8 ;
SPEC ;SPECIAL CONSIDERATION(S) FOR A 2507 REQUEST
+1 KILL DVBSCW
+2 SET DVBSCWA=""
+3 NEW DVBX
+4 ;DVBIEN is the 2507 REQUEST FILE IEN
+5 ;DVBSC is a the SPECIAL CONSIDERATION entry for the 2507 REQUEST
+6 ;DVBSCN is the pointer number to the SPECIAL CONSIDERATION file 396.25
+7 ;DVBSCW is the string /name of the SPECIAL CONSIDERATION
+8 if '$DATA(^DVB(396.3,DVBIEN,8,0))
QUIT
+9 SET DVBAA=$PIECE(^DVB(396.3,DVBIEN,8,0),U,4)
+10 SET (DVBSC,DVBCNT)=0
FOR
SET DVBSC=$ORDER(^DVB(396.3,DVBIEN,8,DVBSC))
if 'DVBSC
QUIT
Begin DoDot:1
+11 SET DVBSCN=$PIECE(^DVB(396.3,DVBIEN,8,DVBSC,0),U,1)
+12 SET DVBSCW(DVBSC)=$GET(^DVB(396.25,DVBSCN,0))
+13 SET DVBCNT=DVBCNT+1
+14 IF (DVBCNT'=DVBAA)
if $DATA(DVBSCW(DVBSC))
SET DVBSCW(DVBSC)=DVBSCW(DVBSC)_","
End DoDot:1
+15 SET DVBX=""
FOR
SET DVBX=$ORDER(DVBSCW(DVBX))
if 'DVBX
QUIT
SET DVBSCWA=DVBSCWA_DVBSCW(DVBX)
+16 QUIT
+17 ;
GETRRDAT ;GRE Input=IEN , get re-route date, to and from site and re-route status
+1 SET (RRDATE,RRTOSITE,RRFRMSITE,RRSTATDTE)=""
+2 if '$DATA(^DVB(396.3,DVBIEN,6,0))
QUIT
+3 ; quit if no re-route data found
+4 KILL RRIENINC,RRSTATINC,RRSTAT,RRDATE,RRTOSITE,RRFRMSITE,RRSTATDTE
+5 SET (RRIENINC,RRSTATINC)=0
+6 FOR
SET RRIENINC=$ORDER(^DVB(396.3,DVBIEN,6,RRIENINC))
if RRIENINC="B"
QUIT
Begin DoDot:1
+7 SET RRFRMSITE=$$EXTERNAL^DILFD(396.34,.02,,$PIECE(^DVB(396.3,DVBIEN,6,RRIENINC,0),U,4))
+8 SET RRDATE=$$FMTE^XLFDT($PIECE(^DVB(396.3,DVBIEN,6,RRIENINC,0),U,1),"5DZ")
+9 SET RRTOSITE=$$EXTERNAL^DILFD(396.34,.02,,$PIECE(^DVB(396.3,DVBIEN,6,RRIENINC,0),U,7))
+10 SET RRSTATINC=0
+11 FOR
SET RRSTATINC=$ORDER(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC))
if RRSTATINC=""
QUIT
Begin DoDot:2
+12 if '$DATA(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC,0))
QUIT
+13 SET RRSTATDTE=$$FMTE^XLFDT($PIECE(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC,0),U,1),"5DZ")
+14 SET RRSTAT=$$EXTERNAL^DILFD(396.341,1,,$PIECE(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC,0),U,2))
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
