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

DVBAB51.m

Go to the documentation of this file. 
  1. DVBAB51 ;ALB/VM - CAPRI INCOMPETENT PATIENT REPORT ; 3/21/12 3:21pm
  1.  ;;2.7;AMIE;**35,149,179,185**;Apr 10, 1995;Build 18
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;Input: ZMSG      - Output Array for incompetent report (By Ref)
  1.  ;       BDATE     - Beginning date for report (FM Format)
  1.  ;       EDATE     - Ending date for report (FM Format)
  1.  ;       DVBADLMTR - Indicates if report should be delimitted (Optional)
  1.  ;                    CAPRI currently executes RPC by each day in 
  1.  ;                    date range, so DVBADLMTR should equal the
  1.  ;                    final EDATE in range so that XTMP global
  1.  ;                    can be killed. 
  1.  ;Output: ^TMP("DVBAR",$J) contains delimited/non-delimited incompetent report
  1. STRT(ZMSG,BDATE,EDATE,DVBADLMTR) ;ENTER HERE
  1.  N DVBAFNLDTE,MA1
  1.  S DVBABCNT=0,RO="N",RONUM=0
  1.  S DVBAFNLDTE=$S(+$G(DVBADLMTR):+$P(DVBADLMTR,"."),1:0)
  1.  S DVBADLMTR=$S('+$G(DVBADLMTR):"",1:",")
  1.  K ^TMP($J),^TMP("DVBAR") G TERM
  1. SET Q:'$D(^DPT(DA,.29))  S ICDAT=^(.29) Q:$P(ICDAT,U,12)'=1&(ICDAT']"")  S INCMP="" S:$P(ICDAT,U)]""!($P(ICDAT,U,12)=1) INCMP=1 Q:INCMP'=1  S ICDAT2=$P(ICDAT,U,2),ICDAT=$P(ICDAT,U)
  1.  S:ICDAT]"" ICDAT=$$FMTE^XLFDT(ICDAT,"5DZ")
  1.  S:ICDAT2]"" ICDAT2=$$FMTE^XLFDT(ICDAT2,"5DZ")
  1.  Q:'$D(^DPT(DA,0))  S DFN=DA D RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)
  1.  S MA1=$P(MA,".",1)
  1.  S ^TMP($J,MA1,XCN,CFLOC,MB,DA)=RCVAA_U_RCVPEN_U_CNUM_U_ICDAT_U_ICDAT2_U_INCMP
  1.  Q
  1.  ;
  1. PRINTB S RCVAA=$P(DATA,U),RCVPEN=$P(DATA,U,2),CNUM=$P(DATA,U,3),ICDAT=$P(DATA,U,4),ICDAT2=$P(DATA,U,5),INCMP=$P(DATA,U,6),DFN=DA,QUIT1=1 D ADM^DVBAVDPT
  1.  S ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
  1.  S DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
  1.  S LADM=ADM,TDIS="UNKNOWN",TO="",DCHPTR=$P(^DGPM(LADM,0),U,17),TDIS=$S($D(^DGPM(+DCHPTR,0)):$P(^(0),U,18),1:"") I TDIS="" S TDIS="Unknown discharge type"
  1.  S:'$D(^DG(405.2,+TDIS,0)) TDIS="Unknown discharge type" I $D(^(0)) S TDIS=$S($P(^DG(405.2,+TDIS,0),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type")
  1.  I '$G(DVBADLMTR)="," S:(IOST?1"C-".E)!($D(DVBAON2)) ^TMP("DVBAR",$J,DVBABCNT)=" ",DVBABCNT=DVBABCNT+1
  1.  ;***vm-out*W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
  1.  ;create delimited/non-delimited report
  1.  D:($G(DVBADLMTR)=",") PRINTD
  1.  D:($G(DVBADLMTR)="") PRINTND
  1.  S DVBAON2=""
  1.  Q
  1.  ;
  1. PRINTND ;create non-delimited incompetent report
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="  Patient Name:    "_PNAM,DVBABCNT=DVBABCNT+1,^TMP("DVBAR",$J,DVBABCNT)=" ",DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="           Claim No:   "_CNUM,DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="  Claim Folder Loc:    "_CFLOC,DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="      Social Sec No:   "_SSN,DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="     Admission Date:   "_ADMDT,DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="Admitting Diagnosis:   "_DIAG,DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="     Discharge Date:   "_DCHGDT,DVBABCNT=DVBABCNT+1
  1.  I DCHGDT]"" S ^TMP("DVBAR",$J,DVBABCNT)="  Type of Discharge:   "_TDIS_$S(TO]"":" TO "_$S($D(^DIC(4,+TO,0)):$P(^(0),U,1),1:""),1:""),DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="        Bed Service:   "_BEDSEC,DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="          Recv A&A?:   "_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="           Pension?:   "_$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1
  1.  ;***vm-out*D ELIG^DVBAVDPT
  1. ELIG S ELIG=DVBAELIG,INCMP=""
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="   Eligibility data:   "
  1.  I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
  1.  I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"")
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_ELIG_$S(((ELIG]"")&(INCMP]"")):", ",1:"")_INCMP,DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="  DATE RULED INCOMP:   "_$S($D(ICDAT)]"":ICDAT_" (VA)",1:"")_$S(ICDAT2]"":" - "_ICDAT2_" (CIVIL)",1:" "),DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=" ",DVBABCNT=DVBABCNT+1
  1.  ;***vm-out*I IOST?1"C-".E W *7,!,"Press RETURN to continue or ""^"" to stop    " R ANS:DTIME S:ANS=U!('$T) QUIT=1 I '$T S DVBAQUIT=1
  1.  Q
  1.  ;
  1. PRINTD ;create delimited incompetent report
  1.  D:('$D(^XTMP("DVBA_INCOMPETENT_RPT"_$J,0))) COLHDR
  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 ^TMP("DVBAR",$J,DVBABCNT)=""""_PNAM_""""_DVBADLMTR_$C(160)_CNUM_DVBADLMTR_CFLOC_DVBADLMTR_SSN_DVBADLMTR_ADMDT_DVBADLMTR_""""_DIAG_""""_DVBADLMTR_DCHGDT_DVBADLMTR
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_$S((DCHGDT]""):TDIS_$S(TO]"":" TO "_$S($D(^DIC(4,+TO,0)):$P(^(0),U,1),1:""),1:""),1:"")_DVBADLMTR
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_""""_BEDSEC_""""_DVBADLMTR_""_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")_DVBADLMTR
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")_DVBADLMTR
  1.  ;
  1.  S ELIG=DVBAELIG,INCMP=""
  1.  I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
  1.  I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"")
  1.  ;
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_""""_ELIG_$S(ELIG]"":", ",1:"")_INCMP_""""_DVBADLMTR_$S($D(ICDAT)]"":ICDAT_" (VA)",1:"")_$S(ICDAT2]"":" - "_ICDAT2_" (CIVIL)",1:"")
  1.  S DVBABCNT=DVBABCNT+1
  1.  Q
  1.  ;
  1. PRINT U IO S QUIT=""
  1.  S MA="" F H=0:0 S MA=$O(^TMP($J,MA)) Q:MA=""!(QUIT=1)  S XCN="" F M=0:0 S XCN=$O(^TMP($J,MA,XCN)) Q:XCN=""!(QUIT=1)  S CFLOC="" F J=0:0 S CFLOC=$O(^TMP($J,MA,XCN,CFLOC)) Q:CFLOC=""!(QUIT=1)  D PRINT1
  1.  Q
  1. PRINT1 S ADM="" F K=0:0 S ADM=$O(^TMP($J,MA,XCN,CFLOC,ADM)) Q:ADM=""!(QUIT=1)  S DA="" F L=0:0 S DA=$O(^TMP($J,MA,XCN,CFLOC,ADM,DA)) Q:DA=""!(QUIT=1)  S DATA=^(DA) D PRINTB
  1.  Q
  1.  ;
  1. TERM ;D HOME^%ZIS K NOASK
  1.  K NOASK
  1.  ;
  1. SETUP ;W @IOF,!,"VARO INCOMPETENCY REPORT" D NOPARM^DVBAUTL2 
  1. NOPARM ;check for AMIE parameter setup
  1.  I '$D(^DVB(396.1,1,0)) S ^TMP("DVBAR",$J,DVBABCNT)="No site parameters have been set up in file 396.1.",DVBABCNT=DVBABCNT+1,^TMP("DVBAR",$J,DVBABCNT)="You must do this before running any reports." S DVBAQUIT=1 H 3
  1.  G:$D(DVBAQUIT) KILL^DVBAUTIL S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
  1.  S HEAD="INCOMPETENCY REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
  1.  ;***vm-out*W !,HEAD1
  1. EN1 ;***vm-out*W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,5) X ^DD("DD") W Y,!!
  1.  ;***vm-out*D DATE^DVBAUTIL G:X=""!(Y<0) KILL
  1.  S %ZIS="Q" D ^%ZIS K %ZIS G:POP KILL^DVBAUTIL
  1.  ;
  1. QUEUE ;***vm-out*I $D(IO("Q")) S ZTRTN="DEQUE^DVBACMRP",ZTIO=ION,NOASK=1,ZTDESC="AMIE INCOMPETENT VET REPORT" F I="FDT(0)","HEAD","HEAD1","BDATE","EDATE","TYPE","RO","RONUM","NOASK" S ZTSAVE(I)=""
  1.  ;***vm-out*I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! G KILL
  1.  ;
  1. GO S MA=BDATE F J=0:0 S MA=$O(^DGPM("AMV1",MA)) Q:$P(MA,".")>EDATE!(MA="")  F DA=0:0 S DA=$O(^DGPM("AMV1",MA,DA)) Q:DA=""  F MB=0:0 S MB=$O(^DGPM("AMV1",MA,DA,MB)) Q:MB=""  D SET I '$D(NOASK) W "."
  1.  I '$D(^TMP($J)) S ^TMP("DVBAR",$J,DVBABCNT)="No data found for parameters entered." H 2 G KILL
  1.  I $D(^TMP($J)) D PRINT K:(DVBAFNLDTE=$P(EDATE,".")) ^XTMP("DVBA_INCOMPETENT_RPT"_$J,0) I $D(DVBAQUIT) K DVBAON2 G KILL^DVBAUTIL
  1.  ;
  1. KILL K:(DVBAFNLDTE=$P(EDATE,".")) ^XTMP("DVBA_INCOMPETENT_RPT"_$J,0)
  1.  S ZMSG=$NA(^TMP("DVBAR",$J))
  1.  D ^%ZISC S X=5 K DVBAON2 D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL
  1.  Q
  1.  ;
  1. DEQUE K ^TMP($J) G GO
  1.  ;
  1. COLHDR ;Column header for delimited report
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=HEAD,DVBABCNT=DVBABCNT+1,^TMP("DVBAR",$J,DVBABCNT)=HEAD1,DVBABCNT=DVBABCNT+1
  1.  S ^TMP("DVBAR",$J,DVBABCNT)="Patient Name"_DVBADLMTR_"Claim No"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_"Social Sec No"_DVBADLMTR_"Admission Date"_DVBADLMTR
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_"Admitting Diagnosis"_DVBADLMTR_"Discharge Date"_DVBADLMTR
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_"Type of Discharge"_DVBADLMTR_"Bed Service"_DVBADLMTR
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_"Recv A&A?"_DVBADLMTR_"Pension?"_DVBADLMTR
  1.  S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_"Eligibility Data"_DVBADLMTR_"Date Ruled Incomp"_$C(13)
  1.  S DVBABCNT=DVBABCNT+1
  1.  S ^XTMP("DVBA_INCOMPETENT_RPT"_$J,0)=DT_U_DT
  1.  Q