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