DVBAB67 ;ALB/KLB - CAPRI PENDING REPORT - PART 2 (called by DVBAB57) ;09/09/00
;;2.7;AMIE;**35,90,185,200**;Apr 10, 1995;Build 2
;
DCHGDT S DCHGDT="",DCHPTR=$P(^DGPM(XJ,0),U,17),XADMDT=$P(^(0),U,1) I DCHPTR]"",$D(^DGPM(+DCHPTR,0)) S DCHGDT=$P(^DGPM(+DCHPTR,0),U,1)
K DCHPTR
Q
;
PRINT S DOCTYPE=$S($D(^DVB(396,DA,2)):$P(^(2),U,10),1:""),DFN=$P(^DVB(396,DA,0),U,1),ADMDT=$P(^(0),U,4),RDATE=$P(^(1),U,1)
S XI=$G(^DPT(DFN,0)),PNAM=$P(XI,U,1),SSN=$P(XI,U,9) Q:PNAM=""!'SSN
S CNUM=$P($G(^DPT(DFN,.31)),U,3) S:CNUM="" CNUM="UNKNOWN"
I RO="Y" S CFLOC=$$STATION^DVBAUTL1(DFN),CFLOC=$S(CFLOC>0:CFLOC,1:9999) Q:CFLOC'=RONUM&(CFLOC'=0)&(CFLOC'=376)
K ^TMP("DVBA","ADMIT",$J)
F XI=0:0 S XI=$O(^DGPM("APTT1",DFN,XI)) Q:XI="" F XJ=0:0 S XJ=$O(^DGPM("APTT1",DFN,XI,XJ)) Q:XJ="" D DCHGDT S ^TMP("DVBA","ADMIT",$J,XADMDT,DFN)=XI_U_DCHGDT
I $G(DVBADLMTR)="," D PRINTDLM G CONT
S:SELDIV="Y" ^TMP("CAPRI",MSGCNT)="Division: "_ADIV_"^",MSGCNT=MSGCNT+1,^TMP("CAPRI",MSGCNT)="^",MSGCNT=MSGCNT+1
S:SELDIV="N" ^TMP("CAPRI",MSGCNT)="Original Division: "_ADIV_"^",MSGCNT=MSGCNT+1,^TMP("CAPRI",MSGCNT)="^",MSGCNT=MSGCNT+1
S ^TMP("CAPRI",MSGCNT)=PNAM_"^",MSGCNT=MSGCNT+1,^TMP("CAPRI",MSGCNT)="SSN: "_SSN_"^",MSGCNT=MSGCNT+1,^TMP("CAPRI",MSGCNT)="Claim no: "_CNUM_"^",MSGCNT=MSGCNT+1
S ^TMP("CAPRI",MSGCNT)=$S(DOCTYPE="L":" Activity date: ",1:"Admission date: ")_$$FMTE^XLFDT(ADMDT,"5DZ")_"^",MSGCNT=MSGCNT+1,^TMP("CAPRI",MSGCNT)="Request date: "_$$FMTE^XLFDT(RDATE,"5DZ")_"^"
;
CONT ; Continue print output creation
S DCHGDT=""
I $D(^TMP("DVBA","ADMIT",$J,+ADMDT,DFN)) S:DOCTYPE="A" DCHGDT=$P(^TMP("DVBA","ADMIT",$J,+ADMDT,DFN),U,2)
D ELAPSED
I $G(DVBADLMTR)="," D PRINTDL2 G ITEMS
I DCHGDT]""_"^" S Y=DCHGDT X ^DD("DD") S ^TMP("CAPRI",MSGCNT)="",MSGCNT=MSGCNT+1,^TMP("CAPRI",MSGCNT)="** Discharged: "_Y_"^",MSGCNT=MSGCNT+1
S ^TMP("CAPRI",MSGCNT)="Elapsed days: "_EDAYS_"^",MSGCNT=MSGCNT+1,^TMP("CAPRI",MSGCNT)="Items Pending:"_"^",MSGCNT=MSGCNT+1
;
ITEMS F Q=9,11,13,15,17,19,21,23,26,28 I $P(^DVB(396,DA,0),U,Q)="P" D PRINT1 Q:DVBAQUIT=1
S Q=7 I $P(^DVB(396,DA,1),U,Q)="P" D PRINT1 Q:DVBAQUIT=1
I $G(DVBADLMTR)=0 D
. S:$D(^DVB(396,DA,2)) ^TMP("CAPRI",MSGCNT)="Requested by: "_$S($P(^DVB(396,DA,2),U,8)]"":$P(^(2),U,8),1:" (Not specified) ")_" AT "_$S($P(^(2),U,7)]"":$P(^(2),U,7),1:" (Not specified) ")_"^",MSGCNT=MSGCNT+1
. S $P(^TMP("CAPRI",MSGCNT),"-")="-^",MSGCNT=MSGCNT+1
. S ^TMP("CAPRI",MSGCNT)="^",MSGCNT=MSGCNT+1
Q
;
PRINT1 S:$D(^DVB(396,DA,6)) GDIVPTR=$P(^DVB(396,DA,6),"^",Q)
S:'$D(^DVB(396,DA,6)) GDIVPTR=$P(^DVB(396,DA,2),"^",9)
S:+GDIVPTR>0 GDIVNAM=$P(^DG(40.8,GDIVPTR,0),"^",1)
S:+GDIVPTR'>0 GDIVNAM=""
S NODTA=1 I $G(DVBADLMTR)=0 D Q
. I QQ S MC=$T(@Q),MD=$P(MC,";;",2) S GDIV=" ("_$E(GDIVNAM,1,(9+(23-$L(MC))))_")" S ^TMP("CAPRI",MSGCNT)=" "_MD_GDIV_"^",MSGCNT=MSGCNT+1 S QQ='QQ Q
. I 'QQ S MC=$T(@Q),MD=$P(MC,";;",2) S GDIV=" ("_$E(GDIVNAM,1,(9+(23-$L(MC))))_")" S ^TMP("CAPRI",MSGCNT)=" "_MD_GDIV_"^",MSGCNT=MSGCNT+1 S QQ='QQ I $Y>22 Q:DVBAQUIT=1
. Q
I (QQ&($G(DVBADLMTR)=",")) S MC=$T(@Q),MD=$P(MC,";;",2),GDIV=" ("_GDIVNAM_")",^TMP("CAPRI",$J,MSGCNT)=PRTREC_""""_MD_GDIV_""""_DVBADLMTR D PRINTDL3
Q
;
ELAPSED K EDAYS S X1=DT,X=RDATE D ^XUWORKDY
S EDAYS=X
Q
;
PRINTDLM ; Print delimited format output details
S PRFX=$S(DOCTYPE="L":"ActivDt ",1:"AdmitDt ")
D DEM^VADPT I $G(VADM(1))'="" S SSN=$S($G(DVBADLMTR)=",":$P($G(VADM(2)),U,2),1:$P($G(VADM(2)),U,1))
S PRTREC=""""_ADIV_""""_DVBADLMTR_""""_PNAM_""""_DVBADLMTR_SSN_DVBADLMTR_$C(160)_CNUM_DVBADLMTR_$S($G(ADMDT)]"":PRFX_$$FMTE^XLFDT(ADMDT,"5DZ"),1:"")_DVBADLMTR_$$FMTE^XLFDT(RDATE,"5DZ")_DVBADLMTR
Q
;
PRINTDL2 ; Continue creating delimited format output
I DCHGDT]""_"^" S Y=DCHGDT X ^DD("DD") S PRTREC=PRTREC_""""_Y_""""_DVBADLMTR
I DCHGDT']""_"^" S Y="",PRTREC=PRTREC_Y_DVBADLMTR
S PRTREC=PRTREC_EDAYS_DVBADLMTR
Q
;
PRINTDL3 ; Last print fields for delimited output
S:$D(^DVB(396,DA,2)) ^TMP("CAPRI",$J,MSGCNT)=^TMP("CAPRI",$J,MSGCNT)_$S($P(^DVB(396,DA,2),U,8)]"":""""_$P(^(2),U,8)_"""",1:"(Not specified) ")_DVBADLMTR_$S($P(^(2),U,7)]"":""""_$P(^(2),U,7)_"""",1:"(Not specified) ")_$C(13),MSGCNT=MSGCNT+1
Q
;
FIELDS ;
7 ;;ADMISSION RPT
9 ;;NOTICE OF DISCHARGE
11 ;;HOSPITAL SUMMARY
13 ;;21-DAY CERTIFICATE
15 ;;OTHER/EXAM REVIEW RMKS
17 ;;SPECIAL REPORT
19 ;;COMPETENCY REPORT
21 ;;VA FORM 21-2680
23 ;;ASSET INFORMATION
26 ;;OPT TREATMENT REPORT
28 ;;BEGINNING DATE/CARE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB67 4507 printed Sep 23, 2025@19:16:32 Page 2
DVBAB67 ;ALB/KLB - CAPRI PENDING REPORT - PART 2 (called by DVBAB57) ;09/09/00
+1 ;;2.7;AMIE;**35,90,185,200**;Apr 10, 1995;Build 2
+2 ;
DCHGDT SET DCHGDT=""
SET DCHPTR=$PIECE(^DGPM(XJ,0),U,17)
SET XADMDT=$PIECE(^(0),U,1)
IF DCHPTR]""
IF $DATA(^DGPM(+DCHPTR,0))
SET DCHGDT=$PIECE(^DGPM(+DCHPTR,0),U,1)
+1 KILL DCHPTR
+2 QUIT
+3 ;
PRINT SET DOCTYPE=$SELECT($DATA(^DVB(396,DA,2)):$PIECE(^(2),U,10),1:"")
SET DFN=$PIECE(^DVB(396,DA,0),U,1)
SET ADMDT=$PIECE(^(0),U,4)
SET RDATE=$PIECE(^(1),U,1)
+1 SET XI=$GET(^DPT(DFN,0))
SET PNAM=$PIECE(XI,U,1)
SET SSN=$PIECE(XI,U,9)
if PNAM=""!'SSN
QUIT
+2 SET CNUM=$PIECE($GET(^DPT(DFN,.31)),U,3)
if CNUM=""
SET CNUM="UNKNOWN"
+3 IF RO="Y"
SET CFLOC=$$STATION^DVBAUTL1(DFN)
SET CFLOC=$SELECT(CFLOC>0:CFLOC,1:9999)
if CFLOC'=RONUM&(CFLOC'=0)&(CFLOC'=376)
QUIT
+4 KILL ^TMP("DVBA","ADMIT",$JOB)
+5 FOR XI=0:0
SET XI=$ORDER(^DGPM("APTT1",DFN,XI))
if XI=""
QUIT
FOR XJ=0:0
SET XJ=$ORDER(^DGPM("APTT1",DFN,XI,XJ))
if XJ=""
QUIT
DO DCHGDT
SET ^TMP("DVBA","ADMIT",$JOB,XADMDT,DFN)=XI_U_DCHGDT
+6 IF $GET(DVBADLMTR)=","
DO PRINTDLM
GOTO CONT
+7 if SELDIV="Y"
SET ^TMP("CAPRI",MSGCNT)="Division: "_ADIV_"^"
SET MSGCNT=MSGCNT+1
SET ^TMP("CAPRI",MSGCNT)="^"
SET MSGCNT=MSGCNT+1
+8 if SELDIV="N"
SET ^TMP("CAPRI",MSGCNT)="Original Division: "_ADIV_"^"
SET MSGCNT=MSGCNT+1
SET ^TMP("CAPRI",MSGCNT)="^"
SET MSGCNT=MSGCNT+1
+9 SET ^TMP("CAPRI",MSGCNT)=PNAM_"^"
SET MSGCNT=MSGCNT+1
SET ^TMP("CAPRI",MSGCNT)="SSN: "_SSN_"^"
SET MSGCNT=MSGCNT+1
SET ^TMP("CAPRI",MSGCNT)="Claim no: "_CNUM_"^"
SET MSGCNT=MSGCNT+1
+10 SET ^TMP("CAPRI",MSGCNT)=$SELECT(DOCTYPE="L":" Activity date: ",1:"Admission date: ")_$$FMTE^XLFDT(ADMDT,"5DZ")_"^"
SET MSGCNT=MSGCNT+1
SET ^TMP("CAPRI",MSGCNT)="Request date: "_$$FMTE^XLFDT(RDATE,"5DZ")_"^"
+11 ;
CONT ; Continue print output creation
+1 SET DCHGDT=""
+2 IF $DATA(^TMP("DVBA","ADMIT",$JOB,+ADMDT,DFN))
if DOCTYPE="A"
SET DCHGDT=$PIECE(^TMP("DVBA","ADMIT",$JOB,+ADMDT,DFN),U,2)
+3 DO ELAPSED
+4 IF $GET(DVBADLMTR)=","
DO PRINTDL2
GOTO ITEMS
+5 IF DCHGDT]""_"^"
SET Y=DCHGDT
XECUTE ^DD("DD")
SET ^TMP("CAPRI",MSGCNT)=""
SET MSGCNT=MSGCNT+1
SET ^TMP("CAPRI",MSGCNT)="** Discharged: "_Y_"^"
SET MSGCNT=MSGCNT+1
+6 SET ^TMP("CAPRI",MSGCNT)="Elapsed days: "_EDAYS_"^"
SET MSGCNT=MSGCNT+1
SET ^TMP("CAPRI",MSGCNT)="Items Pending:"_"^"
SET MSGCNT=MSGCNT+1
+7 ;
ITEMS FOR Q=9,11,13,15,17,19,21,23,26,28
IF $PIECE(^DVB(396,DA,0),U,Q)="P"
DO PRINT1
if DVBAQUIT=1
QUIT
+1 SET Q=7
IF $PIECE(^DVB(396,DA,1),U,Q)="P"
DO PRINT1
if DVBAQUIT=1
QUIT
+2 IF $GET(DVBADLMTR)=0
Begin DoDot:1
+3 if $DATA(^DVB(396,DA,2))
SET ^TMP("CAPRI",MSGCNT)="Requested by: "_$SELECT($PIECE(^DVB(396,DA,2),U,8)]"":$PIECE(^(2),U,8),1:" (Not specified) ")_" AT "_$SELECT($PIECE(^(2),U,7)]"":$PIECE(^(2),U,7),1:" (Not specified) ")_"^"
SET MSGCNT=MSGCNT+1
+4 SET $PIECE(^TMP("CAPRI",MSGCNT),"-")="-^"
SET MSGCNT=MSGCNT+1
+5 SET ^TMP("CAPRI",MSGCNT)="^"
SET MSGCNT=MSGCNT+1
End DoDot:1
+6 QUIT
+7 ;
PRINT1 if $DATA(^DVB(396,DA,6))
SET GDIVPTR=$PIECE(^DVB(396,DA,6),"^",Q)
+1 if '$DATA(^DVB(396,DA,6))
SET GDIVPTR=$PIECE(^DVB(396,DA,2),"^",9)
+2 if +GDIVPTR>0
SET GDIVNAM=$PIECE(^DG(40.8,GDIVPTR,0),"^",1)
+3 if +GDIVPTR'>0
SET GDIVNAM=""
+4 SET NODTA=1
IF $GET(DVBADLMTR)=0
Begin DoDot:1
+5 IF QQ
SET MC=$TEXT(@Q)
SET MD=$PIECE(MC,";;",2)
SET GDIV=" ("_$EXTRACT(GDIVNAM,1,(9+(23-$LENGTH(MC))))_")"
SET ^TMP("CAPRI",MSGCNT)=" "_MD_GDIV_"^"
SET MSGCNT=MSGCNT+1
SET QQ='QQ
QUIT
+6 IF 'QQ
SET MC=$TEXT(@Q)
SET MD=$PIECE(MC,";;",2)
SET GDIV=" ("_$EXTRACT(GDIVNAM,1,(9+(23-$LENGTH(MC))))_")"
SET ^TMP("CAPRI",MSGCNT)=" "_MD_GDIV_"^"
SET MSGCNT=MSGCNT+1
SET QQ='QQ
IF $Y>22
if DVBAQUIT=1
QUIT
+7 QUIT
End DoDot:1
QUIT
+8 IF (QQ&($GET(DVBADLMTR)=","))
SET MC=$TEXT(@Q)
SET MD=$PIECE(MC,";;",2)
SET GDIV=" ("_GDIVNAM_")"
SET ^TMP("CAPRI",$JOB,MSGCNT)=PRTREC_""""_MD_GDIV_""""_DVBADLMTR
DO PRINTDL3
+9 QUIT
+10 ;
ELAPSED KILL EDAYS
SET X1=DT
SET X=RDATE
DO ^XUWORKDY
+1 SET EDAYS=X
+2 QUIT
+3 ;
PRINTDLM ; Print delimited format output details
+1 SET PRFX=$SELECT(DOCTYPE="L":"ActivDt ",1:"AdmitDt ")
+2 DO DEM^VADPT
IF $GET(VADM(1))'=""
SET SSN=$SELECT($GET(DVBADLMTR)=",":$PIECE($GET(VADM(2)),U,2),1:$PIECE($GET(VADM(2)),U,1))
+3 SET PRTREC=""""_ADIV_""""_DVBADLMTR_""""_PNAM_""""_DVBADLMTR_SSN_DVBADLMTR_$CHAR(160)_CNUM_DVBADLMTR_$SELECT($GET(ADMDT)]"":PRFX_$$FMTE^XLFDT(ADMDT,"5DZ"),1:"")_DVBADLMTR_$$FMTE^XLFDT(RDATE,"5DZ")_DVBADLMTR
+4 QUIT
+5 ;
PRINTDL2 ; Continue creating delimited format output
+1 IF DCHGDT]""_"^"
SET Y=DCHGDT
XECUTE ^DD("DD")
SET PRTREC=PRTREC_""""_Y_""""_DVBADLMTR
+2 IF DCHGDT']""_"^"
SET Y=""
SET PRTREC=PRTREC_Y_DVBADLMTR
+3 SET PRTREC=PRTREC_EDAYS_DVBADLMTR
+4 QUIT
+5 ;
PRINTDL3 ; Last print fields for delimited output
+1 if $DATA(^DVB(396,DA,2))
SET ^TMP("CAPRI",$JOB,MSGCNT)=^TMP("CAPRI",$JOB,MSGCNT)_$SELECT($PIECE(^DVB(396,DA,2),U,8)]"":""""_$PIECE(^(2),U,8)_"""",1:"(Not specified) ")_DVBADLMTR_$SELECT($PIECE(^(2),U,7)]"":""""_$PIECE(^(2),U,7)_"""",1:"(Not specified) ")_$CHAR(13)
SET MSGCNT=MSGCNT+1
+2 QUIT
+3 ;
FIELDS ;
7 ;;ADMISSION RPT
9 ;;NOTICE OF DISCHARGE
11 ;;HOSPITAL SUMMARY
13 ;;21-DAY CERTIFICATE
15 ;;OTHER/EXAM REVIEW RMKS
17 ;;SPECIAL REPORT
19 ;;COMPETENCY REPORT
21 ;;VA FORM 21-2680
23 ;;ASSET INFORMATION
26 ;;OPT TREATMENT REPORT
28 ;;BEGINNING DATE/CARE
+1 QUIT
