DVBAB52 ;ALB/SPH - CAPRI ADMISSION INQ BY DATE ;09/01/00
;;2.7;AMIE;**35**;Apr 10, 1995
;
STRT(ZMSG,BDATE,EDATE) ;
S DVBABCNT=0
K ^TMP($J) G TERM
SET 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
Q
;
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
S:ADMDT]"" ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
S:DCHGDT]"" DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
W:(IOST?1"C-".E!($D(DVBAON2))) @IOF
S ZMSG(DVBABCNT)="" S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)="" S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Patient Name: "_PNAM S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Claim No: "_CNUM S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Claim Folder Loc: "_CFLOC S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Social Sec No: "_SSN S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Admission Date: "_ADMDT S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Admitting Diagnosis: "_DIAG S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Discharge Date: "_DCHGDT S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Bed Service: "_BEDSEC S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Recv A&A?: "_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified") S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Pension?: "_$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified") S DVBABCNT=DVBABCNT+1
;
;ELIG INFO...
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 ZMSG(DVBABCNT)=" Eligibility data: "_ELIG_$S(ELIG]"":", ",1:"")
S DVBABCNT=DVBABCNT+1
W:$X>60 !?26 S ZMSG(DVBABCNT)=INCMP S DVBABCNT=DVBABCNT+1
Q
;END OF ELIG INFO
;
PRINT U IO S QUIT="" K MA,MB
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 ;
SETUP ;
EN1 ;
QUEUE ;
S RO="N"
S RONUM=0
S HEAD=""
S HEAD1=""
GO S MA=BDATE F J=0:0 S MA=$O(^DGPM("AMV1",MA)) Q:$P(MA,".")>EDATE!(MA="") W:'$D(NOASK) "." 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
I '$D(^TMP($J)) U IO W !!,*7,"No data found for parameters entered.",!! H 2 G KILL
I $D(^TMP($J)) D PRINT I $D(DVBAQUIT) K DVBAON2,DCHPTR,M,Y,J G KILL^DVBAUTIL
;
KILL D ^%ZISC S X=3 K DVBAON2,DCHPTR,M,Y,J D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL
;
DEQUE K ^TMP($J) G GO
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB52 2874 printed Sep 23, 2025@19:16:26 Page 2
DVBAB52 ;ALB/SPH - CAPRI ADMISSION INQ BY DATE ;09/01/00
+1 ;;2.7;AMIE;**35**;Apr 10, 1995
+2 ;
STRT(ZMSG,BDATE,EDATE) ;
+1 SET DVBABCNT=0
+2 KILL ^TMP($JOB)
GOTO TERM
SET if $DATA(^DPT(DA,0))
QUIT
SET DFN=DA
DO RCV^DVBAVDPT
if CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)
QUIT
+1 SET ^TMP($JOB,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM
+2 QUIT
+3 ;
PRINTB SET MA=$PIECE(DATA,U)
SET RCVAA=$PIECE(DATA,U,2)
SET RCVPEN=$PIECE(DATA,U,3)
SET CNUM=$PIECE(DATA,U,4)
SET DFN=DA
SET QUIT1=1
DO ADM^DVBAVDPT
+1 if ADMDT]""
SET ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
+2 if DCHGDT]""
SET DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
+3 if (IOST?1"C-".E!($DATA(DVBAON2)))
WRITE @IOF
+4 SET ZMSG(DVBABCNT)=""
SET DVBABCNT=DVBABCNT+1
+5 SET ZMSG(DVBABCNT)=""
SET DVBABCNT=DVBABCNT+1
+6 SET ZMSG(DVBABCNT)=" Patient Name: "_PNAM
SET DVBABCNT=DVBABCNT+1
+7 SET ZMSG(DVBABCNT)=" Claim No: "_CNUM
SET DVBABCNT=DVBABCNT+1
+8 SET ZMSG(DVBABCNT)=" Claim Folder Loc: "_CFLOC
SET DVBABCNT=DVBABCNT+1
+9 SET ZMSG(DVBABCNT)=" Social Sec No: "_SSN
SET DVBABCNT=DVBABCNT+1
+10 SET ZMSG(DVBABCNT)=" Admission Date: "_ADMDT
SET DVBABCNT=DVBABCNT+1
+11 SET ZMSG(DVBABCNT)=" Admitting Diagnosis: "_DIAG
SET DVBABCNT=DVBABCNT+1
+12 SET ZMSG(DVBABCNT)=" Discharge Date: "_DCHGDT
SET DVBABCNT=DVBABCNT+1
+13 SET ZMSG(DVBABCNT)=" Bed Service: "_BEDSEC
SET DVBABCNT=DVBABCNT+1
+14 SET ZMSG(DVBABCNT)=" Recv A&A?: "_$SELECT(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")
SET DVBABCNT=DVBABCNT+1
+15 SET ZMSG(DVBABCNT)=" Pension?: "_$SELECT(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")
SET DVBABCNT=DVBABCNT+1
+16 ;
+17 ;ELIG INFO...
+18 SET ELIG=DVBAELIG
SET INCMP=""
+19 IF ELIG]""
SET ELIG=ELIG_" ("_$SELECT(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
+20 IF $DATA(^DPT(DA,.29))
SET INCMP=$SELECT($PIECE(^(.29),U,12)=1:"Incompetent",1:"")
+21 SET ZMSG(DVBABCNT)=" Eligibility data: "_ELIG_$SELECT(ELIG]"":", ",1:"")
+22 SET DVBABCNT=DVBABCNT+1
+23 if $X>60
WRITE !?26
SET ZMSG(DVBABCNT)=INCMP
SET DVBABCNT=DVBABCNT+1
+24 QUIT
+25 ;END OF ELIG INFO
+26 ;
PRINT USE IO
SET QUIT=""
KILL MA,MB
+1 SET XCN=""
FOR M=0:0
SET XCN=$ORDER(^TMP($JOB,XCN))
if XCN=""!(QUIT=1)
QUIT
SET CFLOC=""
FOR J=0:0
SET CFLOC=$ORDER(^TMP($JOB,XCN,CFLOC))
if CFLOC=""!(QUIT=1)
QUIT
DO PRINT1
+2 QUIT
PRINT1 SET ADM=""
FOR K=0:0
SET ADM=$ORDER(^TMP($JOB,XCN,CFLOC,ADM))
if ADM=""!(QUIT=1)
QUIT
SET DA=""
FOR L=0:0
SET DA=$ORDER(^TMP($JOB,XCN,CFLOC,ADM,DA))
if DA=""!(QUIT=1)
QUIT
SET DATA=^(DA)
DO PRINTB
+1 QUIT
+2 ;
TERM ;
SETUP ;
EN1 ;
QUEUE ;
+1 SET RO="N"
+2 SET RONUM=0
+3 SET HEAD=""
+4 SET HEAD1=""
GO SET MA=BDATE
FOR J=0:0
SET MA=$ORDER(^DGPM("AMV1",MA))
if $PIECE(MA,".")>EDATE!(MA="")
QUIT
if '$DATA(NOASK)
WRITE "."
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
IF MA'>EDATE
DO SET
+1 IF '$DATA(^TMP($JOB))
USE IO
WRITE !!,*7,"No data found for parameters entered.",!!
HANG 2
GOTO KILL
+2 IF $DATA(^TMP($JOB))
DO PRINT
IF $DATA(DVBAQUIT)
KILL DVBAON2,DCHPTR,M,Y,J
GOTO KILL^DVBAUTIL
+3 ;
KILL DO ^%ZISC
SET X=3
KILL DVBAON2,DCHPTR,M,Y,J
if $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
GOTO FINAL^DVBAUTIL
+1 ;
DEQUE KILL ^TMP($JOB)
GOTO GO
