DVBASPD2 ;ALB/GTS-557/THM,SBW-AMIE SPECIAL REPORT ; 3/MAY/2011
 ;;2.7;AMIE;**3,57,149,168,185**;Apr 10, 1995;Build 18
 ;Per VHA Directive 2004-038, this routine should not be modified.
 ;
 
^TMP($JTERM
SET 
Q:'$D(^DPT(DA,0))  DFN=DA RCV^DVBAVDPT Q:RCVPEN'=1&(REP="P")  Q:RCVAA'=1&(REP="A")  Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)
 
DCHPTR=$P(^DGPM(MB,0),U,17),TDIS=$S($D(^DGPM(+DCHPTR,0)):$P(^(0),U,18),1:"")
 
+TDIS,'$D(^TMP("DVBA",$J,"DUP",+TDIS)) Q
 S 
TDIS=$S($P($G(^DG(405.2,+TDIS,0)),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type")
 
^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM_U_TDIS
 
Q
 
;
PRINTB W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF
 
!!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
 
?10,REP(0),?26,PNAM,!!,?14,REP(1),?26,CNUM,!,?6,REP(2),?26,XCFLOC,!,?9,REP(3),?26,SSN,!,?8,REP(4),?26,ADMDT,!,?3,REP(5),?26,DIAG,!
 
?8,REP(6),?26,DCHGDT,! W:DCHGDT]"" ?5,REP(7),?26,$$DIS,!
 
?11,REP(8),?26,BEDSEC,!,?13,REP(9),?26,$$RAA,!
 
?14,REP(10),?26,$$PEN,! ELIG^DVBAVDPT
 
IOST?1"C-".*7,!,"Press RETURN to continue or ""^"" to stop    " ANS:DTIME S:ANS=U!('$TQUIT=1 '$T S DVBAQUIT=1 '$T S DVBAQUIT=1
 
DVBAON2=""
 
Q
RAA() Q $S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")
PEN() Q $S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")
DIS() TDIS_$S(TO]"":" TO "_$S($D(^DIC(4,+TO,0)):$P(^(0),U,1),1:""),1:"")
SP(N,M) S $P(M," ",N-1)=" " M  ;pass one arg, 2nd for local use
PRINTC J=0:1:7 ^TMP("DVBSPCRP",$J,DVBC+J)=DVBS(J;NakedRefs = ^TMP("DVBSPCRP",$J,DVBC+J)
 
DVBC=DVBC+6,^TMP("DVBSPCRP",$J,DVBC)=$$SP(10)_REP(0)_PNAM
 
^(DVBC+2)=$$SP(14)_REP(1)_CNUM
 
^(DVBC+3)=$$SP(6)_REP(2)_XCFLOC
 
^(DVBC+4)=$$SP(9)_REP(3)_SSN
 
^(DVBC+5)=$$SP(8)_REP(4)_ADMDT
 
^(DVBC+6)=$$SP(3)_REP(5)_DIAG
 
DVBC=DVBC+7,^(DVBC)=$$SP(8)_REP(6)_DCHGDT
 
DCHGDT]"" D
 
.DVBC=DVBC+1,^(DVBC)=$$SP(5)_REP(7)_$$DIS
 
^(DVBC+1)=$$SP(11)_REP(8)_BEDSEC
 
^(DVBC+2)=$$SP(13)_REP(9)_$$RAA
 
DVBC=DVBC+3,^(DVBC)=$$SP(14)_REP(10)_$$PEN
 
ELIG^DVBAVDPT
 
Q
 
;
PRINTD ;print delimited special report
 
ELIG,INCMP,DVBADATA,DVBABRKER,X,X1,X2,X3
 
DVBABRKER=$$BROKER^XWBLIB
 
ELIG=DVBAELIG,INCMP=""
 
ELIG]"" ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
 
I $D(^DPT(DA,.29)) INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"")
 
INCMP]"",ELIG]"" ELIG=ELIG_", "_INCMP
 
D:('DVBADHDRCOLHDR
 
DVBADATA=PNAM_DVBADLMTR_CNUM_DVBADLMTR_XCFLOC_DVBADLMTR
 
DVBADATA=DVBADATA_SSN_DVBADLMTR_ADMDT_DVBADLMTR_DIAG_DVBADLMTR_DCHGDT_DVBADLMTR
 
DVBADATA=DVBADATA_$S(DCHGDT]"":$$DIS,1:"")_DVBADLMTR_BEDSEC_DVBADLMTR
 
DVBADATA=DVBADATA_$$RAA_DVBADLMTR_$$PEN_DVBADLMTR_ELIG
 
;
 
X=$P(DVBADATA,DVBADLMTR,4)
 
I $L(X)'>9 X=""""_$E("000000000",1,9-$L(X))_X_"""",X1=$E(X,1,4),X2=$E(X,5,6),X3=$E(X,7,11),X=X1_"-"_X2_"-"_X3
 
I $E(X,10,10)'?.X=""""_$E("0000000000",1,10-$L(X))_X_"""",X1=$E(X,1,4),X2=$E(X,5,6),X3=$E(X,7,12),X=X1_"-"_X2_"-"_X3
 
S $P(DVBADATA,DVBADLMTR,4)=X
 
X=$P(DVBADATA,DVBADLMTR,2)
 
X=$C(160)_X
 
S $P(DVBADATA,DVBADLMTR,2)=X
 
I=1:1:$L(DVBADATA,DVBADLMTRI $P(DVBADATA,DVBADLMTR,I)["," S $P(DVBADATA,DVBADLMTR,I)=""""_$P(DVBADATA,DVBADLMTR,I)_""""
 
DVBADATA=$TR(DVBADATA,DVBADLMTR,",")
 
;
 
D:DVBABRKER
 
.^TMP("DVBSPCRP",$J,DVBC)=DVBADATA,DVBC=DVBC+1
 
D:('DVBABRKER)
 .
!,DVBADATA
 
Q
 
;
PRINT QUIT="",XCN=""
 
F  S XCN=$O(^TMP($J,XCN)) Q:XCN=""!(QUIT=1)  XCFLOC="" F  S XCFLOC=$O(^TMP($J,XCN,XCFLOC)) Q:XCFLOC=""!(QUIT=1)  PRINT1
 
Q
PRINT1 ADM="" F  S ADM=$O(^TMP($J,XCN,XCFLOC,ADM)) Q:ADM=""!(QUIT=1)  D
 
.DA="" F  S DA=$O(^TMP($J,XCN,XCFLOC,ADM,DA)) Q:DA=""!(QUIT=1)  D
 
..DATA=^(DA),MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3)
 ..
CNUM=$P(DATA,U,4),TDIS=$P(DATA,U,5),DFN=DA,TO="",QUIT1=1
 ..
ADM^DVBAVDPT
 ..
S:ADMDT]"" ADMDT=$E(ADMDT,4,5)_"/"_$E(ADMDT,6,7)_"/"_$E(ADMDT,2,3)
 ..
S:DCHGDT]"" DCHGDT=$E(DCHGDT,4,5)_"/"_$E(DCHGDT,6,7)_"/"_$E(DCHGDT,2,3)
 ..
I $$BROKER^XWBLIB @$S(($G(DVBADLMTR)=""):"PRINTC",1:"PRINTD"Q
 
..@$S(($G(DVBADLMTR)=""):"PRINTB",1:"PRINTD")
 
Q
SETUP RPT="VARO REPORT"_$S(REP="A":" FOR A & A",1:" FOR PENSION"),DTAR=^DVB(396.1,1,0),FDT(0)=$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3)
 
HEAD="SPECIAL "_$S(REP="A":"A & A",1:"PENSION")_" REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
 
Y=$P(DTAR,U,9) ^DD("DD"REP("LRUN")="Last report was run on "_Y
 
REP(0)="Patient Name:",REP(1)="Claim No:"
 
REP(2)="Claim Folder Loc:",REP(3)="Social Sec No:"
 
REP(4)="Admission Date:",REP(5)="Admitting Diagnosis:"
 
REP(6)="Discharge Date:",REP(7)="Type of Discharge:"
 
REP(8)="Bed Service:",REP(9)="Recv A&A?:",REP(10)="Pension?:"
 
Q
TERM HOME^%ZIS,SETUP NOASK
 
@IOF,!,RPT,!,HEAD1
 
;
EN1 !!,"Please enter dates for search, oldest date first, most recent date last.",!!,REP("LRUN"),!!
 
DATE^DVBAUTIL
 
G:X=""!(Y<0) KILL
 
%ZIS="Q" ^%ZIS %ZIS G:POP KILL^DVBAUTIL
 
;
QUEUE I $D(IO("Q")) ZTRTN="DEQUE^DVBASPD2",ZTIO=ION,NOASK=1,ZTDESC="AMIE PENSION/A&A REPORT" I="^TMP(""DVBA"",$J,""DUP"",","DVBATYPS","REP","FDT(0)","HEAD","HEAD1","BDATE","EDATE","TYPE","RO","RONUM","NOASK" ZTSAVE(I)=""
 
I $D(IO("Q")) ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! KILL
 
;
GO MA=BDATE F  S MA=$O(^DGPM("AMV1",MA)) Q:$P(MA,".")>EDATE!(MA="")  W:'$D(NOASK"." DA=0:0 DA=$O(^DGPM("AMV1",MA,DA)) Q:DA=""  MB=0:0 MB=$O(^DGPM("AMV1",MA,DA,MB)) Q:MB=""  SET
 
S:'$D(^TMP($J)) ER="No data found for parameters entered."
 
G:$$BROKER^XWBLIB BROKER
 
IO I $D(ER!!,*7,ER,!! KILL
 
PRINT
 
I $D(DVBAQUITD:$D(ZTQUEUEDKILL^%ZTLOAD ER,DVBAON2 KILL^DVBAUTIL
 
;
KILL ^%ZISC D:$D(ZTQUEUEDKILL^%ZTLOAD X=9 ER,DVBAON2 FINAL^DVBAUTIL
 
;
INIT ;add header info to report
 
($G(DVBADLMTR)'=""D  Q  ;no header info for delimited report
 
.DVBC=1
 
J=0,2,5,6,7 DVBS(J)=" "
 
S $P(DVBS(1),"-",70)="-",DVBS(3)=$$SP(70-$L(HEAD)\2)_HEAD,DVBS(4)=$$SP(70-$L(HEAD1)\2)_HEAD1
 
^TMP("DVBSPCRP",$J,1)=" ",^(2)=RPT,^(3)=HEAD1,^(4)=" ",^(5)=REP("LRUN"),DVBC=6
 
J=0:1:10 REP(J)=REP(J)_"    "
 
Q
BROKER I $D(ER^TMP("DVBSPCRP",$J^($J,1)=ER
 
E  D INIT,PRINT
 
X=9 FINAL^DVBAUTIL
 
;
 ;Input: DVBADLMTR - Indicates if report should be delimited (Optional)
SPECRPT(ZMSG,DCTYPES,BDATE,EDATE,RONUM,REP,DVBADLMTR)      ;
 
I,J,REQ,DVBC,DVBACEPT,DVBS,ER,DVBADHDR
 
DVBADLMTR=$S('+$G(DVBADLMTR):"",1:"^"),DVBADHDR=0
 
; If RONUM not passed set value to "0" (zero) in order to include data
 ; for all regional offices
 
I $G(RONUM)']"" RONUM=0
 
ZMSG=$NA(^TMP("DVBSPCRP",$J)),REQ=" IS REQUIRED"
 
MB=" MUST BE ",TYPE="REPORT TYPE",BDT="BEGINNING DATE",EDT="ENDING DATE"
 
I $G(BDATE)="" ER=BDT_REQ
 
I $G(EDATE)="" ER=EDT_REQ
 
EDATE<BDATE ER=BDT_MB_"BEFORE THE "_EDT
 
I $G(REP)="" ER=TYPE_REQ
 
"^A^P"'[REP ER=TYPE_MB_"'A' OR 'P'"
 ;Only validate RONUM to be valid Station Number if it isn't zero
 
RONUM'="0"&(RONUM'?3N.4ANER="REGIONAL OFFICE"_MB_"3 NUMBERS + OPTIONAL 1 TO 4 MODIFIER (MAX 7 CHARACTERS)"
 
^TMP("DVBSPCRP",$JI $D(ER^($J,1)=ER,X=9 FINAL^DVBAUTIL
 
;If RONUM = 0 then RO set to "N" to include data for all ROs
 ;If RONUM passed then RO set to "Y" to include data for only passed RO
 
(NOASK,DVBACEPT)=1,RO=$S(RONUM=0:"N",1:"Y")
 
J=0:0 J=$O(DCTYPES(J)) Q:'J  ^TMP("DVBA",$J,"DUP",DCTYPES(J))=""
 
SETUP
DEQUE 
^TMP($JGO
 
;
COLHDR ;Column header for delimited report
 
DVBACHDR,DVBABRKER,DVBADLMTR
 
DVBADLMTR=","
 
DVBABRKER=$$BROKER^XWBLIB
 
DVBACHDR="Patient Name"_DVBADLMTR_"Claim No"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR
 
DVBACHDR=DVBACHDR_"Social Sec No"_DVBADLMTR_"Admission Date"_DVBADLMTR_"Admitting Diagnosis"_DVBADLMTR
 
DVBACHDR=DVBACHDR_"Discharge Date"_DVBADLMTR_"Type of Discharge"_DVBADLMTR_"Bed Service"_DVBADLMTR
 
DVBACHDR=DVBACHDR_"Recv A&A?"_DVBADLMTR_"Pension?"_DVBADLMTR_"Eligibility Data"
 
S:DVBABRKER ^TMP("DVBSPCRP",$J,DVBC)=DVBACHDR,DVBC=DVBC+1
 
D:('DVBABRKER)
 .
!,DVBACHDR
 
DVBADHDR=1  ;set so header info only printed once
 
Q