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

DVBAADRP.m

Go to the documentation of this file.
  1. DVBAADRP ;ALB/GTS-557/THM-AMIE COMPLETE ADMISSION RPT ; 1/22/91 1:19 PM
  1. ;;2.7;AMIE;**17,42,53,108,149,185**;Apr 10, 1995;Build 18
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. N DVBGUI
  1. S DVBGUI=0
  1. K ^TMP($J) G TERM
  1. Q
  1. ;
  1. ENBROKER(Y) ;
  1. ; Returns some info for the CAPRI GUI to display prior
  1. ; to the user running this report
  1. N DVBGUI
  1. S DVBGUI=1
  1. K ^TMP($J)
  1. D HOME^%ZIS K NOASK,QUIT1
  1. D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
  1. ;
  1. S Y(1)="VARO COMPLETE ADMISSION REPORT" S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
  1. S HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
  1. S Y(2)=HEAD1,Y(3)=""
  1. S Y(4)="Please enter dates for search, oldest date first, most recent date last."
  1. S Y=$P(DTAR,U,3) X ^DD("DD")
  1. S Y(5)=""
  1. S Y(6)="Last report was run on "_Y
  1. Q
  1. ;
  1. ;Input: DVBADLMTR - Indicates if report should be delimited (Optional)
  1. ENBROKE2(MSG,BDATE,EDATE,RO,RONUM,DVBADLMTR) ;
  1. ; This is the entry point to run the actual report from
  1. ; the CAPRI GUI.
  1. N DVBHFS,DVBERR,DVBGUI,I,DVBADHDR
  1. K ^TMP("DVBA",$J)
  1. S DVBADLMTR=$S('+$G(DVBADLMTR):"",1:","),DVBADHDR=0
  1. S DVBGUI=1,DVBERR=0,DVBHFS=$$HFS^DVBAB82()
  1. S X=BDATE,Y=EDATE
  1. ; DVBA*2.7*108 - Correct next line. CAPRI GUI already adds 1 to EDATE
  1. ; S BDATE=BDATE-.5,EDATE=EDATE+.5
  1. S BDATE=BDATE-.5,EDATE=EDATE-.5
  1. K ^TMP($J)
  1. D HOME^%ZIS K NOASK,QUIT1
  1. D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
  1. ;
  1. S HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
  1. I $D(X) D
  1. . G:X=""!(Y<0) KILL S %ZIS="AEQ" D ^%ZIS K %ZIS
  1. D HFSOPEN^DVBAB82("DVBRP",DVBHFS,"W") I DVBERR D END^DVBAB82 Q
  1. I POP K DVBAON2,DCHPTR,M,Y,J G KILL^DVBAUTIL
  1. U IO
  1. D DEQUE
  1. D END^DVBAB82
  1. Q
  1. SET Q:'$D(^DPT(DA,0)) S DFN=DA D RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)
  1. S ^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM
  1. Q
  1. ;
  1. PRINTB S MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),DFN=DA,QUIT1=1 D ADM^DVBAVDPT
  1. S:ADMDT]"" ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
  1. S:DCHGDT]"" DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
  1. D:($G(DVBADLMTR)'="") PRINTD
  1. D:($G(DVBADLMTR)="") PRINTND
  1. Q
  1. ;
  1. PRINTND ;print non-delimited admission inq report
  1. W:(IOST?1"C-".E!($D(DVBAON2))) @IOF
  1. I DVBGUI=0 W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
  1. I DVBGUI=1 W !!
  1. W ?10,"Patient Name:",?26,PNAM,!!,?14,"Claim No:",?26,CNUM,!,?6,"Claim Folder Loc:",?26,CFLOC,!,?9,"Social Sec No:",?26,SSN,!,?8,"Admission Date:",?26,ADMDT,!,?3,"Admitting Diagnosis:",?26,DIAG,!
  1. W ?8,"Discharge Date:",?26,DCHGDT,!,?11,"Bed Service:",?26,BEDSEC,!,?13,"Recv A&A?:",?26,$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified"),!
  1. W ?14,"Pension?:",?26,$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),! D ELIG^DVBAVDPT I IOST'?1"C-".E S DVBAON2=""
  1. I IOST?1"C-".E DO
  1. .I ($O(^TMP($J,XCN))'=""!($O(^TMP($J,XCN,CFLOC))'=""!($O(^TMP($J,XCN,CFLOC,ADM))'=""!($O(^TMP($J,XCN,CFLOC,ADM,DA))'="")))) DO
  1. ..I DVBGUI=0 D
  1. ...W *7,!,"Press RETURN to continue or ""^"" to stop "
  1. ...R ANS:DTIME
  1. ...S:ANS=U!('$T) QUIT=1
  1. ...I '$T S DVBAQUIT=1
  1. .I ($O(^TMP($J,XCN))=""&($O(^TMP($J,XCN,CFLOC))=""&($O(^TMP($J,XCN,CFLOC,ADM))=""&($O(^TMP($J,XCN,CFLOC,ADM,DA))="")))) DO
  1. ..I DVBGUI=0 D
  1. ...W *7,!,"Press RETURN to continue "
  1. ...R ANS:DTIME
  1. Q
  1. ;
  1. PRINTD ;print delimited admission inq report
  1. ;eligibility logic copied from ELIG^DVBAVDPT
  1. N ELIG,INCMP
  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. I INCMP]"",ELIG]"" S ELIG=ELIG_", "_INCMP
  1. D DEM^VADPT I $G(SSN)'="" S SSN=$P($G(VADM(2)),U,2)
  1. D:('DVBADHDR) COLHDR
  1. W !,""""_PNAM_""""_DVBADLMTR_$C(160)_CNUM_DVBADLMTR_CFLOC_DVBADLMTR_SSN_DVBADLMTR_ADMDT_DVBADLMTR_""""_DIAG_""""_DVBADLMTR
  1. W DCHGDT_DVBADLMTR_""""_BEDSEC_""""_DVBADLMTR_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")_DVBADLMTR
  1. W $S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")_DVBADLMTR_""""_ELIG_""""
  1. Q
  1. ;
  1. PRINT U IO S QUIT="" K MA,MB
  1. 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
  1. Q
  1. 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
  1. Q
  1. ;
  1. TERM D HOME^%ZIS K NOASK,QUIT1
  1. D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
  1. ;
  1. SETUP W @IOF,!,"VARO COMPLETE ADMISSION REPORT" S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
  1. S HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
  1. W !,HEAD1
  1. EN1 W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,3) X ^DD("DD") W Y,!!
  1. D DATE^DVBAUTIL
  1. G:X=""!(Y<0) KILL S %ZIS="AEQ" D ^%ZIS K %ZIS
  1. I POP K DVBAON2,DCHPTR,M,Y,J G KILL^DVBAUTIL
  1. ;
  1. QUEUE I $D(IO("Q")) S ZTRTN="DEQUE^DVBAADRP",ZTIO=ION,NOASK=1,ZTDESC="AMIE ADMISSION REPORT" F I="BDATE","EDATE","HEAD","HEAD1","RO","RONUM","FDT(0)","NOASK" S ZTSAVE(I)=""
  1. 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="") W:(('$D(NOASK))&($G(DVBADLMTR)="")) "." 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="" I MA'>EDATE D SET
  1. I '$D(^TMP($J)) D H 2 G KILL
  1. .U IO
  1. .W:($G(DVBADLMTR)="") !!,*7
  1. .W "No data found for parameters entered.",!!
  1. W:(($G(DVBGUI)=1)&($G(DVBADLMTR)="")) !,HEAD,!,HEAD1,!
  1. I $D(^TMP($J)) D PRINT I $D(DVBAQUIT) K DVBAON2,DCHPTR,M,Y,J G KILL^DVBAUTIL
  1. ;
  1. KILL ;
  1. D ^%ZISC S X=3 K DVBAON2,DCHPTR,M,Y,J D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL
  1. ;
  1. DEQUE K ^TMP($J) G GO
  1. ;
  1. COLHDR ;Column header for delimited report
  1. W "Patient Name"_DVBADLMTR_"Claim No"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR
  1. W "Social Sec No"_DVBADLMTR_"Admission Date"_DVBADLMTR_"Admitting Diagnosis"_DVBADLMTR
  1. W "Discharge Date"_DVBADLMTR_"Bed Service"_DVBADLMTR_"Recv A&A?"_DVBADLMTR
  1. W "Pension?"_DVBADLMTR_"Eligibility Data"
  1. S DVBADHDR=1 ;set so header info only printed once
  1. Q