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

DVBAB6.m

Go to the documentation of this file. 
  1. DVBAB6 ;ALB/DJS - CAPRI PENDING 2507 REQUEST REPORT ; 9/8/21 3:59pm
  1.  ;;2.7;AMIE;**35,90,108,168,185,190,192,193,227,241**;Apr 10, 1995;Build 4
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. STRT(MSG,DVBCSORT,RSTAT,ERDAYS,OLDAYS,ADIVNUM,ELTYP,DVBADLMTR,ROFILTER) ;
  1.  ; MSG=DATA Passed back from RPC to GUI;(.MSG,"A","NR",1,1,7613,"W",0,0)
  1.  ;DVBCSORT=Sort by("A"GE,"S"TATUS,"V"ETERAN NAME,"R"OUTING LOCATION)
  1.  ;RSTAT= Routing Status("N"ew,"P"ending","T"ranscribed,"NR"New Re-Routed,"RP"Re-routed pending acceptance,"RA"Re-routed acceptance accepted --
  1.  ;       routing status continued - "RR"Re-routed rejected,"RS"RE-routed pending at to site,'A'll statuses)
  1.  ;ERDAYS= Earliest age if SORTBY is "A"("1" earliest, "7" latest)
  1.  ;OLDAYS = OLDEST AGE IF SORTBY IS "A"("1"=earliest, "7" oldest)
  1.  ;ADIVNUM=ROUTING LOCATION -DIVISION IEN     
  1.  ;ELTYP= REPORT TYPE("W"ORK DAYS, "C"ALENDAR DAYS)
  1.  ;DVBADLMTR= DELIMITER("0"= PLAIN TEXT, "1"=COMMA DELIMITED
  1.  ;ROFILTER = MODE ("0"=LOCAL MODE, "1"=REMOTE MODE)   SDAT,EDAT,RSTAT,DELIM,YNODT
  1.  I ADIVNUM'="" S X=$O(^DG(40.8,"C",ADIVNUM,"")) S:X]"" ADIVNUM=X
  1.  S DVBADLMTR=$S(DVBADLMTR=1:",",1:0),ROFILTER=$S($G(ROFILTER)'=0:ROFILTER,1:0)
  1. SETUP K ^TMP($J),^TMP("CAPRI")
  1.  S DVBCDT(0)=$$FMTE^XLFDT(DT,"5DZ"),PG=1,DVBCCNT=0,DONE="NO",MSGCNT=1,TRNSFIN=""
  1.  S DVBCHDR="Sorted by "_$S(DVBCSORT="V":"VETERAN NAME",DVBCSORT="R":"Routing location",DVBCSORT="S":"Status",DVBCSORT="A":"Age of request",1:"Unknown")
  1.  I $G(DVBADLMTR)'="," D HEADRND G DATA
  1.  I $G(DVBADLMTR)="," D HEADRD G DATA
  1.  Q
  1. HEADRND ; Print non-delimited output header
  1.  ;
  1.  S ^TMP("CAPRI",MSGCNT)=HEAD_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)=PROCDT_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="^",MSGCNT=MSGCNT+1
  1.  S $P(^TMP("CAPRI",MSGCNT),"=",75)="=^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="",MSGCNT=MSGCNT+1
  1.  Q
  1. HEADRD ; Print delimited output header
  1.  ;
  1.  S ^TMP("CAPRI",MSGCNT)=HEAD_$C(13),MSGCNT=MSGCNT+1,^TMP("CAPRI",MSGCNT)=PROCDT_$C(13),MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)=$S($G(ROFILTER)'=0:"RO #"_DVBADLMTR,1:"")_"Division"_DVBADLMTR_"Status"_DVBADLMTR_"Veteran Name"_DVBADLMTR_"SSN"_DVBADLMTR_"Claim No."_DVBADLMTR_"Request Date"_DVBADLMTR
  1.  S ^TMP("CAPRI",MSGCNT)=^TMP("CAPRI",MSGCNT)_"Elapsed Days"_DVBADLMTR_"Transferred in from"_DVBADLMTR_"Requested by Name"_DVBADLMTR_"Requested by Division"_DVBADLMTR_"Exams Requested"_DVBADLMTR_"Exam Status"_DVBADLMTR
  1.  S ^TMP("CAPRI",MSGCNT)=^TMP("CAPRI",MSGCNT)_"Cell Phone"_DVBADLMTR_"Email Address"_DVBADLMTR_"Claim Type"_DVBADLMTR_"Special Consideration(s)"_DVBADLMTR_"ReRouted From"_DVBADLMTR_"ReRouted to"_$C(13)
  1.  S MSGCNT=MSGCNT+1
  1.  Q
  1.  ;
  1. DATA ; Sort data records
  1.  ;
  1.  S DFN="" F  S DFN=$O(^DVB(396.3,"B",DFN)) Q:DFN=""  F REQDA=0:0 S REQDA=$O(^DVB(396.3,"B",DFN,REQDA)) Q:REQDA=""  D SORT^DVBAB5
  1.  N EXAMRECRD
  1.  ;I DVBCSORT="V" S PNAM="" F  S PNAM=$O(^TMP($J,PNAM)) Q:PNAM=""  F DFN=0:0 S DFN=$O(^TMP($J,PNAM,DFN)) Q:'DFN  F DA(1)=0:0 S DA(1)=$O(^TMP($J,PNAM,DFN,DA(1))) Q:'DA(1)  D PRINT I $D(OUT) S DA(1)=999999999,PNAM="ZZZ",DONE="YES" Q
  1.  I DVBCSORT="V" S PNAM="" F  S PNAM=$O(^TMP($J,PNAM)) Q:PNAM=""  F DFN=0:0 S DFN=$O(^TMP($J,PNAM,DFN)) Q:'DFN  F DA(1)=0:0 S DA(1)=$O(^TMP($J,PNAM,DFN,DA(1))) Q:'DA(1)  D PRINT
  1.  I DVBCSORT="R"!(DVBCSORT="A")!(DVBCSORT="S") D
  1.  . S JX="" F  S JX=$O(^TMP($J,JX)) Q:JX=""  D
  1.  .. S PNAM="" F  S PNAM=$O(^TMP($J,JX,PNAM)) Q:PNAM=""  D
  1.  ... F DFN=0:0 S DFN=$O(^TMP($J,JX,PNAM,DFN)) Q:'DFN  D NXT
  1.  I DVBCCNT>0 S ^TMP("CAPRI",MSGCNT)="Total pending: "_DVBCCNT,DONE="YES"
  1.  ;
  1. EXIT I NODATA=0 S ^TMP("CAPRI",MSGCNT)="No pending request found for select parameters.",MSG=$NA(^TMP("CAPRI"))
  1.  I DONE="YES" S MSG=$NA(^TMP("CAPRI"))
  1.  K ^TMP($J),ADIV,CNUM,NODATA,STATUS,TST,TSTA1,STSAT,PG,PRTNM,RDATE,RDATE1,REQDA,SSN,RONAME,JX,TRNSFIN,PROCDT,REQSTR,MSGCNT,TSTAT
  1.  K DA,DFN,DONE,DVBCCNT,DVBCDT,DVBCHDR,X,XX,ZS,ZZZ,HEAD,HEAD2,OUT,OWNDOM,EDAYS,PNAM,DVBADLMTR,EXAMRECRD,ROFILTER,RONUM,VADM
  1.  K DVBAA,DVBCELL,DVBCNT,DVBCTW,DVBEMA,DVBSC,DVBSCN,DVBSCNS,DVBSCW,DVBSCWA,DVBX
  1.  Q
  1.  ;
  1. PRINT ; print 2507 request data
  1.  ;
  1.  S ADIV=$S($D(^DVB(396.3,DA(1),1)):$P(^(1),U,4),1:"") Q:ADIV'=ADIVNUM&(DVBCSORT="R")  I ADIV]"" S ADIV=$S($D(^DG(40.8,+ADIV,0)):$P(^(0),U,1),1:"Unknown Division")
  1.  S RDATE1=$P(^DVB(396.3,DA(1),0),U,2),RDATE=$P(^(0),U,5)
  1.  S SSN=$P($G(^DPT(DFN,0)),U,9) S:SSN="" SSN="Unknown"
  1.  S DVBCELL=$P($G(^DPT(DFN,.13)),U,4)
  1.  S DVBEMA=$P($G(^DPT(DFN,.13)),U,3)
  1.  S CNUM=$P($G(^DPT(DFN,.31)),U,3) S:CNUM="" CNUM="Unknown"
  1.  S OWNDOM=$P(^DVB(396.3,DA(1),0),U,22) I OWNDOM]"" S TRNSFIN=$S($D(^DIC(4.2,+OWNDOM,0)):$P(^(0),U,1),1:"Unknown Site") I $G(DVBADLMTR)=0 S ^TMP("CAPRI",MSGCNT)="Transferred in from "_TRNSFIN_"^",MSGCNT=MSGCNT+1
  1.  D ELAPSED^DVBAB5
  1.  ;AJF;Request Status conversion Reports ;
  1.  S STATUS="Unknown",XX=$$RSTAT^DVBCUTL8($P(^DVB(396.3,DA(1),0),U,18))
  1.  S STATUS=$$EXTERNAL^DILFD(396.3,17,,$P(^DVB(396.3,DA(1),0),U,18))
  1.  ;S STATUS=$S(XX="N":"New",XX="P":"Pending, reported",XX="S":"Pending, scheduled",XX="R":"Released to RO, not printed",1:"")
  1.  ;I STATUS="",$D(XX) S STATUS=$S(XX="C":"Completed, printed by RO",XX="X":"Cancelled by RO",XX="T":"Transcribed",XX="NT":"New,Transferred in",XX="CT":"Completed, Transferred out",1:"Unknown")
  1.  I $G(DVBADLMTR)="," D PRINTD,ITEMS Q
  1.  S ^TMP("CAPRI",MSGCNT)="Division: "_ADIV_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="Status: "_STATUS_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)=PNAM_" ^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="SSN: "_SSN_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="Cell no.: "_DVBCELL_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="Email: "_DVBEMA_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="Claim no: "_CNUM_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="Request Date: "_$$FMTE^XLFDT(RDATE1,"5DZ")_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="Elapsed days: "_EDAYS_"^",MSGCNT=MSGCNT+1
  1.  S X=$S($D(^DVB(396.3,DA(1),4)):^(4),1:"")
  1.  D CLAIMTYP,SPEC,REROUTE
  1.  S ^TMP("CAPRI",MSGCNT)="ReRouted From: "_DVBRRF_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="ReRouted To: "_DVBRRT_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="Claim Type: "_DVBCTW_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="Special Consideration(s): "_DVBSCWA_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="Exams requested:"_"^",MSGCNT=MSGCNT+1
  1.  ;
  1. ITEMS S NODATA=1,REQSTR=+$P(^DVB(396.3,DA(1),0),U,4)
  1.  S ZZZ="Requested by: "_$S($D(^VA(200,+REQSTR,0)):$P(^(0),U,1),1:" (Not specified) ")_" at "
  1.  S RONAME=$P(^DVB(396.3,DA(1),0),U,3),RONAME=$S(RONAME]"":$P(^DIC(4,+RONAME,0),U,1),1:"")
  1.  I $G(DVBADLMTR)'="," D ITEMSND Q
  1.  I $G(DVBADLMTR)="," D ITEMSD Q
  1. ITEMSND D TST S ^TMP("CAPRI",MSGCNT)="^"_ZZZ_$S(RONAME]"":RONAME,1:" (Not specified) ")_"^",MSGCNT=MSGCNT+1
  1.  S ^TMP("CAPRI",MSGCNT)="^",MSGCNT=MSGCNT+1
  1.  S $P(^TMP("CAPRI",MSGCNT),"-",75)="-^",MSGCNT=MSGCNT+1
  1.  S DVBCCNT=DVBCCNT+1
  1.  Q
  1. ITEMSD S ZZZ=$S($D(^VA(200,+REQSTR,0)):$P(^(0),U,1),1:" (Not specified) ")
  1.  S EXAMRECRD=EXAMRECRD_""""_ZZZ_""""_DVBADLMTR_""""_RONAME_""""_DVBADLMTR
  1.  D TST S DVBCCNT=DVBCCNT+1
  1.  Q
  1.  ;
  1. PRINTD ; Print delimited format output on report
  1.  ;
  1.  I OWNDOM']"" S TRNSFIN=""
  1.  S RONUM=$P(^DVB(396.3,DA(1),0),U,3)
  1.  D DEM^VADPT I $G(VADM(1))'="" S SSN=$S(DVBADLMTR=",":$P($G(VADM(2)),U,2),1:$P($G(VADM(2)),U,1))
  1.  S EXAMRECRD=$S($G(ROFILTER)'=0:RONUM_DVBADLMTR,1:"")_""""_ADIV_""""_DVBADLMTR_""""_STATUS_""""_DVBADLMTR_""""_PNAM_""""_DVBADLMTR
  1.  S EXAMRECRD=EXAMRECRD_SSN_DVBADLMTR_$C(160)_CNUM_DVBADLMTR_$$FMTE^XLFDT(RDATE1,"5DZ")_DVBADLMTR_EDAYS_DVBADLMTR_TRNSFIN_DVBADLMTR
  1.  Q
  1.  ;
  1. NXT ;F DA(1)=0:0 S DA(1)=$O(^TMP($J,JX,PNAM,DFN,DA(1))) Q:DA(1)=""  D PRINT I $D(OUT) S DA(1)="",PNAM="ZZZZ",JX=$S($A(JX)>57:PNAM,1:9999999),DONE="YES"
  1.  F DA(1)=0:0 S DA(1)=$O(^TMP($J,JX,PNAM,DFN,DA(1))) Q:DA(1)=""  D PRINT
  1.  Q
  1. TST F DA=0:0 S DA=$O(^DVB(396.4,"C",DA(1),DA)) Q:DA=""  K PRINT S TSTAT=$P(^DVB(396.4,DA,0),U,4),TST=$P(^DVB(396.4,DA,0),U,3),PRTNM=$S($D(^DVB(396.6,TST,0)):$P(^(0),U,2),1:"") D TST1
  1.  Q
  1. TST1 S TSTA1=""
  1.  I $D(^DVB(396.4,DA,"CAN")) S TSTA1=$P(^DVB(396.4,DA,"CAN"),U,3)
  1.  I $D(^DVB(396.4,DA,"TRAN")) S X=$P(^DVB(396.4,DA,"TRAN"),U,3)
  1.  S:TSTA1]"" TSTA1=$P(^DVB(396.5,TSTA1,0),U,1)
  1.  I $G(DVBADLMTR)'="," D
  1.  . S ^TMP("CAPRI",MSGCNT)=$S(PRTNM]"":PRTNM,1:"Missing exam name")
  1.  . S ^TMP("CAPRI",MSGCNT)=^TMP("CAPRI",MSGCNT)_$S(TSTA1]"":" - cancelled ("_TSTA1_")",TSTAT="T":" - Transferred",TSTAT]"":" - "_$$EXTERNAL^DILFD(396.4,.04,,TSTAT),TSTAT="":" (Unknown status)",1:"")_"^"
  1.  . S MSGCNT=MSGCNT+1
  1.  . I TSTAT="T" S X=$S($D(^DIC(4.2,+X,0)):$P(^(0),U,1),1:"unknown site") S ^TMP("CAPRI",MSGCNT)=" to "_$P(X,".",1),MSGCNT=MSGCNT+1
  1.  . Q
  1.  I $G(DVBADLMTR)="," D
  1.  . D CLAIMTYP,SPEC,REROUTE
  1.  . S PRTNM=$S(PRTNM]"":PRTNM,1:"Missing exam name"),TSTAT=$S(TSTA1]"":"Cancelled ("_TSTA1_")",TSTAT="T":"Transferred",TSTAT]"":$$EXTERNAL^DILFD(396.4,.04,,TSTAT),TSTAT="":" (Unknown status)",1:"")
  1.  . S ^TMP("CAPRI",MSGCNT)=EXAMRECRD_""""_PRTNM_""""_DVBADLMTR_""""_TSTAT_""""_DVBADLMTR_""""_DVBCELL_""""_DVBADLMTR_""""_DVBEMA_""""_DVBADLMTR_""""_DVBCTW_""""_DVBADLMTR_""""_DVBSCWA_""""_DVBADLMTR_""""_DVBRRF_""""_DVBADLMTR_""""_DVBRRT_""""
  1.  . I TSTAT="T" S X=$S($D(^DIC(4.2,+X,0)):$P(^(0),U,1),1:"unknown site") S ^TMP("CAPRI",MSGCNT)=^TMP("CAPRI",MSGCNT)_" to "_$P(X,".",1)
  1.  . S ^TMP("CAPRI",MSGCNT)=^TMP("CAPRI",MSGCNT)_$C(13)
  1.  S MSGCNT=MSGCNT+1
  1.  Q
  1. CLAIMTYP ;THE CLAIM TYPE OF A 2507 REQUEST
  1.  S DVBCTW=""
  1.  Q:'$D(^DVB(396.3,DA(1),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,DA(1)_",","9.1*","E","MSG","ERR")
  1.  S DVBCTW=$G(MSG("396.32","1,"_DA(1)_",",".01","E"))
  1.  Q
  1.  ;
  1. SPEC ;SPECIAL CONSIDERATION(S) FOR A 2507 REQUEST
  1.  K DVBSCW
  1.  S DVBSCWA=""
  1.  Q:'$D(^DVB(396.3,DA(1),8))
  1.  ;DA(1) 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.  S DVBAA=$P(^DVB(396.3,DA(1),8,0),U,4)
  1.  ;S DVBAA=$P($G(^DVB(396.3,DA(1),8,0)),U,4)
  1.  S (DVBSC,DVBCNT)=0 F  S DVBSC=$O(^DVB(396.3,DA(1),8,DVBSC)) Q:'DVBSC  D
  1.  .S DVBSCN=$P(^DVB(396.3,DA(1),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. REROUTE ;REROUTE INFO FOR A 2507 REQUEST
  1.  ;DVBRRT is site rerouted to
  1.  ;DVBRRF is the site rerouted from
  1.  S (DVBRRT,DVBRRF)=""
  1.  Q:'$D(^DVB(396.3,DA(1),6,0))
  1.  ; quit if no re-route data found
  1.  K DVBINC,DVBRRF,DVBRRT
  1.  S DVBINC=0
  1.  F  S DVBINC=$O(^DVB(396.3,DA(1),6,DVBINC)) Q:DVBINC="B"  D
  1.  . S DVBRRF=$$EXTERNAL^DILFD(396.34,.02,,$P(^DVB(396.3,DA(1),6,DVBINC,0),U,4))
  1.  . S DVBRRT=$$EXTERNAL^DILFD(396.34,.02,,$P(^DVB(396.3,DA(1),6,DVBINC,0),U,7))
  1.  Q
  1.  ;