Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBARSBD

DVBARSBD.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  Q  ;NO DIRECT ENTRY
  1.  ;
  1. REQSTAT(DVBSDAT,DVBEDAT,DVBRSTAT,DVBDELIM,DVBNODT) ;entry for request status by dt range
  1.  ;
  1.  ;  Input:
  1.  ;    DVBSDAT - start date (FM format)
  1.  ;    DVBEDAT - end date (FM format)
  1.  ;    DVBRSTAT - request status (internal format)
  1.  ;    DVBDELIM - return delimited results (0=no;1=yes)
  1.  ;    DVBNODT - ignore date range (0=no;1=yes)
  1.  ;
  1.  N EXSTAT  ;request status (external format)
  1.  N EXSDAT  ;start date (external format: MM/DD/YYYY)
  1.  N EXEDAT  ;end date (external format: MM/DD/YYYY)
  1.  N DVBARS  ;request status conversion results
  1.  N DVBERR  ;FM error msg
  1.  N DVBCNT  ;returned record count
  1.  ;GRE- 193 ;Request Status conversion Report changes ;
  1.  N RRIENINC ; re-route ien counter
  1.  N RRDATE  ;re-route date
  1.  N RRTOSITE  ;re-route to site
  1.  N RRFRMSITE ; re-route from site;
  1.  N RRSTATINC ; re-route status counter
  1.  N RRSTATDTE ; re-route status date
  1.  N RRSTAT    ; re-route status
  1.  N DVBLINE  ;header separator
  1.  ;GRE ; end Request Status conversion Report changes ;
  1.  K ^TMP("DVBREQ",$J),^TMP("DVBREQN",$J)
  1.  S EXSDAT=$$FMTE^XLFDT(DVBSDAT,"5DZ")
  1.  S EXEDAT=$$FMTE^XLFDT(DVBEDAT,"5DZ")
  1.  S (RRDATE,RRFRMSITE,RRTOSITE,RRSTATDTE,RRSTAT)="",(RRIENINC,RRSTATINC)=0
  1.  S $P(DVBLINE,"-",131)=""
  1.  I DVBRSTAT="RN" S DVBRSTAT="NR"
  1.  I DVBRSTAT="A" S EXSTAT="ALL"
  1.  E  D
  1.  . D CHK^DIE(396.3,17,"E",DVBRSTAT,.DVBARS,"DVBERR")
  1.  . S EXSTAT=$G(DVBARS(0))
  1.  S DVBCNT=1
  1.  S DVBAD=$S(DVBDELIM=1:",",1:0)
  1.  ;
  1.  ;collect records matching search criteria
  1.  I DVBNODT D
  1.  . S EXSDAT="NO START DATE"
  1.  . S EXEDAT="NO END DATE"
  1.  . I DVBDELIM D DELIMHDR(EXSDAT,EXEDAT,EXSTAT)
  1.  . D GETRECSN(DVBRSTAT,.DVBCNT)
  1.  E  D
  1.  . I DVBDELIM D DELIMHDR(EXSDAT,EXEDAT,EXSTAT)
  1.  . D GETRECS(DVBSDAT,DVBEDAT,DVBRSTAT,.DVBCNT)
  1. D I 'DVBCNT D
  1.  . W "NO DATA FOUND"
  1.  E  D
  1.  . I 'DVBDELIM D PLAINHDR(EXSDAT,EXEDAT,EXSTAT),PLAIN  ;plain text format
  1.  . I DVBDELIM D DELIM  ;comma delimited format
  1.  ;
  1. END ;Clean up local variables
  1.  K DIWF,DIWL,DIWR,DVBAD,DVBAX,DVBAY,DVBCNRS,DVBEXAM,DVBIEN4,DVBI2,DVBX,DVBXCNT,LINE,X
  1.  K DVBAD,DVBAX,DVBAY,DVBCT,DVBCTN,DVBCTW,DVBIEN4,DVBI2,DIWF,DIWL,DIWR,DVBX,DVBSC,DVBSCC,DVBSCN,DVBSCW,DVBSCWA,DVBXCNT,LINE,X
  1.  K DVBSCNS,DVBAA,^TMP("DVBREQ",$J),^TMP("DVBREQH",$J)
  1.  K DVBREQH,DVBREQL2,DVBREQL3,DVBI22,MSG,RCC,RCR,RRFRMSITE
  1.  Q
  1.  ;
  1. 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
  1.  ;DATE STATUS LAST CHANGED within the start and end dates and have
  1.  ;a REQUEST STATUS that matches the input request status parameter.
  1.  ;
  1.  ;  Input:
  1.  ;    SDAT - start date (FM format)
  1.  ;    EDAT - end date (FM format)
  1.  ;    RSTAT - request status (internal format)
  1.  ;    CNT - record count (passed by reference)
  1.  ;
  1.  N CHGDAT  ;change date
  1.  N DVBIEN  ;2507 REQUEST IEN
  1.  N DVBSTAT ;2507 REQUEST STATUS
  1.  N FLD     ;field array in external format
  1.  S CHGDAT=SDAT-1
  1.  S DVBIEN=0,CNT=0 F  S CHGDAT=$O(^DVB(396.3,"AH",CHGDAT)) Q:'CHGDAT!(CHGDAT>EDAT)  D
  1.  . F  S DVBIEN=$O(^DVB(396.3,"AH",CHGDAT,DVBIEN)) Q:'DVBIEN  D
  1.  . . ;AJF; Request Status Conversion
  1.  . . S DVBSTAT=$$RSTAT^DVBCUTL8($P(^DVB(396.3,DVBIEN,0),U,18))
  1.  . . I RSTAT="A"!(DVBSTAT=RSTAT) D
  1.  . . . K FLD
  1.  . . . I $$SETFLDS(DVBIEN,.FLD) D
  1.  . . . . S CNT=CNT+1,DVBXCNT=1
  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
  1.  . . . . . 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
  1.  . . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=^TMP("DVBREQ",$J,CNT,DVBIEN)_FLD("DVBCTW")_U_FLD("DVBSCWA")_U_RRDATE_U_RRTOSITE_U_RRFRMSITE
  1.  . . . . . S CNT=CNT+1,DVBXCNT=DVBXCNT+1
  1.  . . . . I $G(DVBAD)="," D
  1.  . . . . . S (RCC,RCR)=""
  1.  . . . . . D:$D(FLD("IEN4",1)) CANFLD
  1.  . . . . . S FLD("CANRS")=RCR,FLD("CANCOM")=RCC
  1.  . . . . . S FLD("RRLOC")=$TR(FLD("RRLOC"),",",""),FLD("RRSTE")=$TR(FLD("RRSTE"),",","")
  1.  . . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=FLD("SS")_DVBAD_""""_FLD("NM")_""""_DVBAD_FLD("REQDT")_DVBAD_FLD("RELDT")_DVBAD_""""_FLD("PRTDT")_""""_DVBAD
  1.  . . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=^TMP("DVBREQ",$J,CNT,DVBIEN)_""""_FLD("RS")_""""_DVBAD_FLD("CANDT")_DVBAD_""""_FLD("RO")_""""_DVBAD
  1.  . . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=^TMP("DVBREQ",$J,CNT,DVBIEN)_""""_FLD("CANRS")_""""_DVBAD_FLD("CANCOM")_DVBAD_""""_FLD("DVBCTW")_""""_DVBAD
  1.  . . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=^TMP("DVBREQ",$J,CNT,DVBIEN)_""""_FLD("DVBSCWA")_""""_DVBAD_FLD("RRDTE")_DVBAD_""""_FLD("RRLOC")_""""_DVBAD
  1.  . . . . . S ^TMP("DVBREQ",$J,CNT,DVBIEN)=^TMP("DVBREQ",$J,CNT,DVBIEN)_""""_FLD("RRSTE")_""""_DVBAD
  1.  . . . . . S CNT=CNT+1
  1.  Q
  1. CANFLD ;
  1.  N RS1,RC1,RRCR,RRCC
  1.  S DVBX=0
  1.  F  S DVBX=$O(FLD("IEN4",DVBX)) Q:'DVBX  D
  1.  . S RS1=FLD("CANRS",DVBX),RC1=FLD("CANCOM",DVBX)
  1.  . S RS1=$E(RS1,1,50),RC1=$E(RC1,1,50)
  1.  . I RS1'="",'$D(RRCR(RS1)) S RRCR(RS1)=""
  1.  . I RC1'="",'$D(RRCC(RC1)) S RRCC(RC1)=""
  1.  S (RCR,RS1)="" F  S RS1=$O(RRCR(RS1)) Q:RS1=""  S RCR=$S(RCR="":RS1,1:RCR_"^"_RS1)
  1.  S (RCC,RC1)="" F  S RC1=$O(RRCC(RC1)) Q:RC1=""  S RCC=$S(RCC="":RC1,1:RCC_"^"_RC1)
  1.  S RCC=$TR(RCC,",","")
  1.  I $L(RCR)>40 S RCR="*"_$E(RCR,1,40)
  1.  I $L(RCC)>40 S RCC="*"_$E(RCC,1,40)
  1.  Q
  1.  ;
  1. SETFLDS(DVBIEN,DVBFLDS) ;build field array in external format
  1.  ;This function formats the collected record data in external format
  1.  ;and returns the results TRUE and an array on success.  Otherwise,
  1.  ;the function returns FALSE.
  1.  ;
  1.  ;  Integration Reference #10061 - DEM^VADPT
  1.  ;
  1.  ;  Input:
  1.  ;    DVBIEN - 2507 REQUEST IEN
  1.  ;    DVBFLDS - field array passed by reference
  1.  ;
  1.  ;  Output:
  1.  ;    DVBFLDS("IEN") - 2507 REQUEST IEN
  1.  ;    DVBFLDS("NM") - patient name
  1.  ;    DVBFLDS("SS") - social security number
  1.  ;    DVBFLDS("RS") - request status
  1.  ;    DVBFLDS("REQDT") - request date
  1.  ;    DVBFLDS("RELDT") - release date
  1.  ;    DVBFLDS("PRTDT") - print date
  1.  ;    DVBFLDS("CANDT") - canceled date
  1.  ;    DVBFLDS("RO") - regional office
  1.  ;    DVBFLDS("IREQDT") - request date in internal FM format
  1.  ;    DVBFLDS("EXAM") - added with patch DVB*2.7*189; HOLDS THE 2507 EXAM name   
  1.  ;    DVBFLDS("CANRS") - added with patch DVB*2.7*189; HOLDS THE 2507 EXAM CANCELLATION REASON name
  1.  ;    DVBFLDS("CANCOM") - added with patch DVB*2.7*189; HOLDS THE 2507 EXAM CANCELLATION COMMENTS name
  1.  ;GRE add re-route fields
  1.  ;    DVBFLDS("RRDATE") - added with patch DVBA*2.7*193 holds the 2507 Re-Route Date
  1.  ;    DVBFLDS("RRSITE") - added with patch DVBA*2.7*193 holds the 2507 Re-Route Site
  1.  ;    DVBFLDS("RRLOC")  - added with patch DVBA*2.7*193 holds the 2507 Re-Route Location
  1.  ;    Function Result - return 1 on success; otherwise returns 0
  1.  ;
  1.  N DFN  ;PATIENT file IEN used in VADPT call
  1.  N DVBDAT  ;2507 REQUEST data field array
  1.  N DVBIENS  ;FM IENS value
  1.  N DVBRSLT  ;function result
  1.  N VADM  ;VADPT return array
  1.  N DVBIEN4 ;the IEN FROM 2507 EXAM FILE 396.4
  1.  N DVBALAST ;number of lines in the wp cancellation comments
  1.  N DVBAI  ;for loop index
  1.  N DVBAX ;
  1.  K DVBFLDS
  1.  S (RRDATE,RRFRMSITE,RRTOSITE)=""
  1.  S DVBRSLT=0
  1.  S DVBIENS=+$G(DVBIEN)_","
  1.  D GETS^DIQ(396.3,DVBIENS,".01;1;2;13;15;17;19","IE","DVBDAT","")
  1.  S DFN=$G(DVBDAT(396.3,DVBIENS,.01,"I"))
  1.  D DEM^VADPT
  1.  I $G(VADM(1))'="" D  ;only return record when name is resolved
  1.  . S DVBFLDS("IEN")=DVBIEN
  1.  . S DVBFLDS("NM")=$G(VADM(1))
  1.  . S DVBFLDS("SS")=$S(DVBDELIM:$P($G(VADM(2)),U,2),1:$P($G(VADM(2)),U,1))
  1.  . S DVBFLDS("RS")=$G(DVBDAT(396.3,DVBIENS,17,"E"))
  1.  . S DVBFLDS("REQDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,1,"I")),"5DZ")
  1.  . S DVBFLDS("RELDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,13,"I")),"5DZ")
  1.  . S DVBFLDS("PRTDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,15,"I")),"5DZ")
  1.  . S DVBFLDS("CANDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,19,"I")),"5DZ")
  1.  . S DVBFLDS("RO")=$G(DVBDAT(396.3,DVBIENS,2,"E"))
  1.  . D CLAIMTYP,SPEC,GETRRDAT
  1.  . S DVBFLDS("DVBCTW")=DVBCTW
  1.  . S DVBFLDS("DVBSCWA")=DVBSCWA
  1.  . S DVBFLDS("RRDTE")=RRDATE
  1.  . S DVBFLDS("RRSTE")=RRFRMSITE
  1.  . S DVBFLDS("RRLOC")=RRTOSITE
  1.  . S DVBXCNT=1
  1.  . S (DVBFLDS("CANRS",DVBXCNT),DVBFLDS("CANCOM",DVBXCNT),DVBFLDS("IEN4"))=""
  1.  . S DVBIEN4=0 F  S DVBIEN4=$O(^DVB(396.4,"C",DVBIEN,DVBIEN4)) Q:'DVBIEN4  D
  1.  . . I $D(^DVB(396.4,DVBIEN4,"CAN")) D
  1.  . . . S DVBAY=($P($P(^DVB(396.4,DVBIEN4,"CAN"),"^",1),".",1)) I DVBAY>(DVBSDAT-1)&DVBAY<(DVBEDAT+1) D
  1.  . . . . S DVBFLDS("CANRS",DVBXCNT)=$$GET1^DIQ(396.4,DVBIEN4,52)
  1.  . . . . I $D(^DVB(396.4,DVBIEN4,5)) D
  1.  . . . . . S DVBFLDS("IEN4",DVBXCNT)=DVBIEN4
  1.  . . . . . 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
  1.  . . . . . ;DVBALAST gets the number of WP lines to loop through in the for loop
  1.  . . . . . S DVBALAST=$P(^DVB(396.4,DVBIEN4,5,0),U,3) S DVBAI="",DVBFLDS("CANCOM",DVBXCNT)=WP(1,0)
  1.  . . . . . F DVBAI=1:1:DVBALAST S DVBFLDS("CANCOM",DVBXCNT)=DVBFLDS("CANCOM",DVBXCNT)_" "_WP(DVBAI,0) Q:$L(DVBFLDS("CANCOM",DVBXCNT))>150
  1.  . . . . . ;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)
  1.  . . . . . S DVBXCNT=DVBXCNT+1
  1.  . S DVBFLDS("IREQDT")=$G(DVBDAT(396.3,DVBIENS,1,"I"))
  1.  . S DVBRSLT=1
  1.  Q DVBRSLT
  1.  ;
  1. DELIMHDR(EXSDAT,EXEDAT,EXSTAT) ;output delimited format header
  1.  ;  Input:
  1.  ;    EXSDAT - start date (external format)
  1.  ;    EXEDAT - end date (external format)
  1.  ;    EXSTAT - request status (external format)
  1.  ; GRE ; added re-route status information to the report
  1.  S ^TMP("DVBREQH",$J,DVBCNT)="Request Status by Date Range Report",DVBCNT=DVBCNT+1
  1.  S ^TMP("DVBREQH",$J,DVBCNT)="Date Range: "_EXSDAT_" - "_EXEDAT,DVBCNT=DVBCNT+1
  1.  S ^TMP("DVBREQH",$J,DVBCNT)=""""_"Request Status: "_EXSTAT_""""_$C(13),DVBCNT=DVBCNT+1
  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
  1.  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
  1.  Q
  1.  ;
  1. DELIM ;output delimited format
  1.  ;
  1.  N DVBI     ;generic counter
  1.  N DVBREQ   ;request record
  1.  ;
  1.  U IO
  1.  S DVBI=0 F  S DVBI=$O(^TMP("DVBREQH",$J,DVBI)) Q:'DVBI  D
  1.  . S DVBREQH=^TMP("DVBREQH",$J,DVBI)
  1.  . W !,DVBREQH
  1.  S DVBI2=0 F  S DVBI2=$O(^TMP("DVBREQ",$J,DVBI2)) Q:'DVBI2  D
  1.  . S DVBIEN=0 F  S DVBIEN=$O(^TMP("DVBREQ",$J,DVBI2,DVBIEN)) Q:'DVBIEN  D
  1.  . . S DVBREQL2=^TMP("DVBREQ",$J,DVBI2,DVBIEN)
  1.  . . W !,DVBREQL2
  1.  . . S DVBI22=0 F  S DVBI22=$O(^TMP("DVBREQ",$J,DVBI2,DVBIEN,DVBI22)) Q:'DVBI22  D
  1.  . . . S DVBREQL3=^TMP("DVBREQ",$J,DVBI2,DVBIEN,DVBI22)
  1.  . . . W !,DVBREQL3
  1.  ;
  1.  Q
  1.  ;
  1. PLAINHDR(EXSDAT,EXEDAT,EXSTAT)  ;output plain text header
  1.  ;Populate the header information.
  1.  ;CAUTION:  The CAPRI GUI pulls this information to populate the header
  1.  ;for each page when creating a printed report.  Do not modify the
  1.  ;content or line count of the header information without validating
  1.  ;against the CAPRI GUI interface.
  1.  ;
  1.  ;CAPRI GUI to populate 
  1.  ;  Input:
  1.  ;    EXSDAT - start date (external format)
  1.  ;    EXEDAT - end date (external format)
  1.  ;    EXSTAT - request status (external format)
  1.  ;
  1.  ; N DVBLINE  ;header separator
  1.  ;
  1.  U IO
  1.  ;S $P(DVBLINE,"-",131)=""
  1.  W !,"Date Range: "_EXSDAT_" - "_EXEDAT
  1.  W !,"Request Status: ",EXSTAT
  1.  W !,"-----------------------------------------------------------------------------------------------"
  1.  Q
  1.  ;
  1. PLAIN ;output plain text format
  1.  ;Output formatted text format.  The patient name and station nameC
  1.  ;are truncated at 20 characters to maintain 132 character report.
  1.  ;
  1.  N DVBI     ;generic counter
  1.  N DVBREQ   ;request record
  1.  U IO
  1.  S DVBI=0
  1.  F  S DVBI=$O(^TMP("DVBREQ",$J,DVBI)) Q:'DVBI  D
  1.  . S DVBIEN=0 F  S DVBIEN=$O(^TMP("DVBREQ",$J,DVBI,DVBIEN)) Q:'DVBIEN  D
  1.  . . S DVBREQ=^TMP("DVBREQ",$J,DVBI,DVBIEN)
  1.   . . D GETRRDAT
  1.  . . W !,DVBLINE
  1.  . . W !,"SSN:",?14,$P(DVBREQ,U,2)
  1.  . . W !,"PATIENT NAME:",?14,$E($P(DVBREQ,U,3),1,20)
  1.  . . W !,"REQUEST DT:",?14,$P(DVBREQ,U,4)
  1.  . . W !,"DT RELEASED:",?14,$P(DVBREQ,U,5)
  1.  . . W !,"DT PRINTED:",?14,$P(DVBREQ,U,6)
  1.  . . W !,"STATUS:",?14,$P(DVBREQ,U,7)
  1.  . . W !,"DT CANCELED:",?14,$P(DVBREQ,U,8)
  1.  . . D CLAIMTYP,SPEC
  1.  . . W !,"CLAIM TYPE: ",DVBCTW
  1.  . . W !,"SPECIAL CONSIDERATION(S):",DVBSCWA
  1.  . . W !,"RE-ROUTE DATE:",RRDATE
  1.  . . W !,"RE-ROUTE FROM SITE:",RRFRMSITE
  1.  . . W !,"RE-ROUTE TO SITE:",RRTOSITE
  1.  . . S DVBIEN4=0 F  S DVBIEN4=$O(^DVB(396.4,"C",DVBIEN,DVBIEN4)) Q:'DVBIEN4  D
  1.  . . . I $D(^DVB(396.4,DVBIEN4,"CAN")) D
  1.  . . . . S DVBAY=($P($P(^DVB(396.4,DVBIEN4,"CAN"),"^",1),".",1)) I DVBAY>(DVBSDAT-1)&DVBAY<(DVBEDAT+1) D
  1.  . . . . . S DVBCNRS=$$GET1^DIQ(396.4,DVBIEN4,52) D
  1.  . . . . . I DVBCNRS'="" D  W !,"CANCELLATION REASON:",?14,DVBCNRS
  1.  . . . . . .;W !,"CANCELLATION REASON:",?14,DVBCNRS
  1.  . . . . . I $D(^DVB(396.4,DVBIEN4,5)) D
  1.  . . . . . . K ^UTILITY($J,"W")
  1.  . . . . . . 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
  1.  Q 
  1.  ;
  1. 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
  1.  ;that matches the input request status parameter regardless of the LAST
  1.  ;STATUS CHANGE DATE range.  The procedure uses the "AF" index which sorts
  1.  ;by REQUEST STATUS and REGIONAL OFFICE.
  1.  ;
  1.  ;  Input:
  1.  ;    RSTAT - request status (internal format)
  1.  ;    DVBCNT - record count (passed by reference)
  1.  ;
  1.  ;
  1.  N DVBIEN  ;2507 REQUEST IEN
  1.  N FLD     ;field array in external format
  1.  N DVBRO   ;regional office
  1.  S DVBRO=0,DVBCNT=0 F  S DVBRO=$O(^DVB(396.3,"AF",RSTAT,DVBRO)) Q:'DVBRO  D
  1.  . S DVBIEN=0
  1.  . F  S DVBIEN=$O(^DVB(396.3,"AF",RSTAT,DVBRO,DVBIEN)) Q:'DVBIEN  D
  1.  . . K FLD
  1.  . . I $$SETFLDS(DVBIEN,.FLD) D
  1.  . . . S DVBXCNT=1
  1.  . . . I $G(DVBAD)'="," D
  1.  . . . . 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
  1.  . . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=^TMP("DVBREQ",$J,DVBCNT,DVBIEN)_FLD("DVBCTW")_U_FLD("DVBSCWA")
  1.  . . . . S DVBCNT=DVBCNT+1,DVBXCNT=DVBXCNT+1
  1.  . . . I $G(DVBAD)="," D
  1.  . . . . S (RCC,RCR)=""
  1.  . . . . D:$D(FLD("IEN4",1)) CANFLD
  1.  . . . . S FLD("CANRS")=RCR,FLD("CANCOM")=RCC
  1.  . . . . S FLD("RRLOC")=$TR(FLD("RRLOC"),",",""),FLD("RRSTE")=$TR(FLD("RRSTE"),",","")
  1.  . . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=FLD("SS")_DVBAD_""""_FLD("NM")_""""_DVBAD_FLD("REQDT")_DVBAD_FLD("RELDT")_DVBAD_""""_FLD("PRTDT")_""""_DVBAD
  1.  . . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=^TMP("DVBREQ",$J,DVBCNT,DVBIEN)_""""_FLD("RS")_""""_DVBAD_FLD("CANDT")_DVBAD_""""_FLD("RO")_""""_DVBAD
  1.  . . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=^TMP("DVBREQ",$J,DVBCNT,DVBIEN)_""""_FLD("CANRS")_""""_DVBAD_FLD("CANCOM")_DVBAD_""""_FLD("DVBCTW")_""""_DVBAD
  1.  . . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=^TMP("DVBREQ",$J,DVBCNT,DVBIEN)_""""_FLD("DVBSCWA")_""""_DVBAD_FLD("RRDTE")_DVBAD_""""_FLD("RRSTE")_""""_DVBAD
  1.  . . . . S ^TMP("DVBREQ",$J,DVBCNT,DVBIEN)=^TMP("DVBREQ",$J,DVBCNT,DVBIEN)_""""_FLD("RRLOC")_""""_DVBAD
  1.  . . . . S DVBCNT=DVBCNT+1
  1.  ;load output global with sorted list
  1.  S CHGDAT="",CNT=0  ;use "" because value could be zero ("0")
  1.  F  S CHGDAT=$O(^TMP("DVBREQN",$J,CHGDAT)) Q:(CHGDAT="")  D
  1.  . S DVBIEN=0
  1.  . F  S DVBIEN=$O(^TMP("DVBREQN",$J,CHGDAT,DVBIEN)) Q:'DVBIEN  D
  1.  . . S CNT=CNT+1
  1.  . . S ^TMP("DVBREQ",$J,CNT)=^TMP("DVBREQN",$J,CHGDAT,DVBIEN)
  1.  Q
  1.  ;
  1. CLAIMTYP ;THE CLAIM TYPE OF A 2507 REQUEST
  1.  S DVBCTW=""
  1.  Q:'$D(^DVB(396.3,DVBIEN,9,0))
  1.  ;DVBIEN is the 2507 REQUEST FILE IEN
  1.  ;DVBCTW is the string /name of the CLAIM TYPE
  1.  D GETS^DIQ(396.3,DVBIEN_",","9.1*","E","MSG","ERR")
  1.  S DVBCTW=$G(MSG("396.32","1,"_DVBIEN_",",".01","E"))
  1.  Q
  1.  ;
  1. SPEC ;SPECIAL CONSIDERATION(S) FOR A 2507 REQUEST
  1.  K DVBSCW
  1.  S DVBSCWA=""
  1.  N DVBX
  1.  ;DVBIEN is the 2507 REQUEST FILE IEN
  1.  ;DVBSC is a the SPECIAL CONSIDERATION entry for the 2507 REQUEST
  1.  ;DVBSCN is the pointer number to the SPECIAL CONSIDERATION file 396.25
  1.  ;DVBSCW is the string /name of the SPECIAL CONSIDERATION
  1.  Q:'$D(^DVB(396.3,DVBIEN,8,0))
  1.  S DVBAA=$P(^DVB(396.3,DVBIEN,8,0),U,4)
  1.  S (DVBSC,DVBCNT)=0 F  S DVBSC=$O(^DVB(396.3,DVBIEN,8,DVBSC)) Q:'DVBSC  D
  1.  .S DVBSCN=$P(^DVB(396.3,DVBIEN,8,DVBSC,0),U,1)
  1.  .S DVBSCW(DVBSC)=$G(^DVB(396.25,DVBSCN,0))
  1.  .S DVBCNT=DVBCNT+1
  1.  .I (DVBCNT'=DVBAA) S:$D(DVBSCW(DVBSC)) DVBSCW(DVBSC)=DVBSCW(DVBSC)_","
  1.  S DVBX="" F  S DVBX=$O(DVBSCW(DVBX)) Q:'DVBX  S DVBSCWA=DVBSCWA_DVBSCW(DVBX)
  1.  Q
  1.  ;
  1. GETRRDAT ;GRE Input=IEN , get re-route date, to and from site and re-route status
  1.  S (RRDATE,RRTOSITE,RRFRMSITE,RRSTATDTE)=""
  1.  Q:'$D(^DVB(396.3,DVBIEN,6,0)) 
  1.   ; quit if no re-route data found
  1.  K RRIENINC,RRSTATINC,RRSTAT,RRDATE,RRTOSITE,RRFRMSITE,RRSTATDTE
  1.  S (RRIENINC,RRSTATINC)=0
  1.  F  S RRIENINC=$O(^DVB(396.3,DVBIEN,6,RRIENINC)) Q:RRIENINC="B"  D
  1.  . S RRFRMSITE=$$EXTERNAL^DILFD(396.34,.02,,$P(^DVB(396.3,DVBIEN,6,RRIENINC,0),U,4))
  1.  . S RRDATE=$$FMTE^XLFDT($P(^DVB(396.3,DVBIEN,6,RRIENINC,0),U,1),"5DZ")
  1.  . S RRTOSITE=$$EXTERNAL^DILFD(396.34,.02,,$P(^DVB(396.3,DVBIEN,6,RRIENINC,0),U,7))
  1.  . S RRSTATINC=0
  1.  . F  S RRSTATINC=$O(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC)) Q:RRSTATINC=""  D
  1.  . . Q:'$D(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC,0))
  1.  . . S RRSTATDTE=$$FMTE^XLFDT($P(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC,0),U,1),"5DZ")
  1.  . . S RRSTAT=$$EXTERNAL^DILFD(396.341,1,,$P(^DVB(396.3,DVBIEN,6,RRIENINC,RRSTATINC,0),U,2))
  1.  Q
  1.  ;