DVBAB51 ;ALB/VM - CAPRI INCOMPETENT PATIENT REPORT ;09/01/00
 ;;2.7;AMIE;**35**;Apr 10, 1995
 ;
STRT(ZMSG,BDATE,EDATE) ;ENTER HERE
 S DVBABCNT=0,RO="N",RONUM=0
 K ^TMP($J) 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 ^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM_U_ICDAT_U_ICDAT2_U_INCMP
 Q
 ;
PRINTB S MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),ICDAT=$P(DATA,U,5),ICDAT2=$P(DATA,U,6),INCMP=$P(DATA,U,7),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")
 S:(IOST?1"C-".E)!($D(DVBAON2)) ZMSG(DVBABCNT)=" ",DVBABCNT=DVBABCNT+1
 ;***vm-out*W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
 S ZMSG(DVBABCNT)="  Patient Name:    "_PNAM,DVBABCNT=DVBABCNT+1,ZMSG(DVBABCNT)=" ",DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="           Claim No:   "_CNUM,DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="   Claim Folder Loc:   "_CFLOC,DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="      Social Sec No:   "_SSN,DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="     Admission Date:   "_ADMDT,DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="Admitting Diagnosis:   "_DIAG,DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="     Discharge Date:   "_DCHGDT,DVBABCNT=DVBABCNT+1
 I DCHGDT]"" S ZMSG(DVBABCNT)="     Type of Discharge:   "_TDIS_$S(TO]"":" TO "_$S($D(^DIC(4,+TO,0)):$P(^(0),U,1),1:""),1:""),DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="        Bed Service:   "_BEDSEC,DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="          Recv A&A?:   "_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1
 S ZMSG(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 ZMSG(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 ZMSG(DVBABCNT)=ELIG_$S(ELIG]"":", ",1:"")_INCMP,DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="  DATE RULED INCOMP: "_$S($D(ICDAT)]"":ICDAT_" (VA)",1:"")_$S(ICDAT2]"":" - "_ICDAT2_" (CIVIL)",1:" "),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
 S DVBAON2=""
 Q
 ;
PRINT U IO S QUIT=""
 S XCN="" F M=0:0 S XCN=$O(^TMP($J,XCN)) Q:XCN=""!(QUIT=1)  S CFLOC="" F J=0:0 S CFLOC=$O(^TMP($J,XCN,CFLOC)) Q:CFLOC=""!(QUIT=1)  D PRINT1
 Q
PRINT1 S ADM="" F K=0:0 S ADM=$O(^TMP($J,XCN,CFLOC,ADM)) Q:ADM=""!(QUIT=1)  S DA="" F L=0:0 S DA=$O(^TMP($J,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 ZMSG(DVBABCNT)="No site parameters have been set up in file 396.1.",DVBABCNT=DVBABCNT+1,ZMSG(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 ZMSG(DVBABCNT)="No data found for parameters entered." H 2 G KILL
 I $D(^TMP($J)) D PRINT I $D(DVBAQUIT) K DVBAON2 G KILL^DVBAUTIL
 ;
KILL D ^%ZISC S X=5 K DVBAON2 D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL
 ;
DEQUE K ^TMP($J) G GO