DVBAB71 ;ALB/KLB - CAPRI REQUEST STATUS INQUIRY ;09/11/00;6/29/2023 @10:54AM
;;2.7;AMIE;**35,250**;Apr 10, 1995;Build 19
;
STRT(MSG,DFN,RECIEN) ;
S U="^"
K ^TMP("CAPRI")
I '$D(DFN) S MSG(1)="You must select a patient."
Q:'$D(DFN)
Q:DFN=""
S PTNAME=$E($P(^DPT(DFN,0),U),1,25)
;S RECIEN=0,RECIEN=$O(^DVB(396,"B",DFN,RECIEN))
S DVB0=$G(^DVB(396,RECIEN,0)),DVB1=$G(^DVB(396,RECIEN,1)),DVB2=$G(^DVB(396,RECIEN,2)),DVB6=$G(^DVB(396,RECIEN,6))
S MCNT=1
;S ^TMP("CAPRI",MCNT)="Patient Name: "_PTNAME_"^",MCNT=MCNT+1
I $P(DVB2,U,10)="L" S DOCTYP="ACTIVITY DATE: "
I $P(DVB2,U,10)="A" S DOCTYP="Admission Date: "
S Y=$P(DVB0,U,4) X ^DD("DD")
S ^TMP("CAPRI",MCNT)=" Patient Name: "_PTNAME_" "_DOCTYP_Y_"^",MCNT=MCNT+1
;S ^TMP("CAPRI",MCNT)="SSN: "_$P(^DPT(DFN,0),U,9)_"^",MCNT=MCNT+1
S ^TMP("CAPRI",MCNT)=" SSN: "_$P(^DPT(DFN,0),U,9)_" Claim Number: "_$P($G(^DPT(DFN,.31)),U,3)_"^",MCNT=MCNT+1 ;CAPRI-4838
S DIV=$P(DVB2,U,9) I DIV'="" S DIV=$P(^DG(40.8,DIV,0),U)
S ^TMP("CAPRI",MCNT)="Receiving Div: "_DIV_"^",MCNT=MCNT+1
S ^TMP("CAPRI",MCNT)=" Requisition Status Status Date Operator Current Division"_"^",MCNT=MCNT+1
S Y=$P(DVB0,U,10) X ^DD("DD") S DIV=$P(DVB6,U,9),STAT=$P(DVB0,U,9) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
I DIV'="" S DIV=$P(^DG(40.8,DIV,0),U)
S ^TMP("CAPRI",MCNT)="---------------------------------------------------------------------------"_"^",MCNT=MCNT+1
S OP=$P(DVB1,U,13) I OP="" S OP=" "
DATA S ^TMP("CAPRI",MCNT)=" Notice/Discharge: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
S Y=$P(DVB0,U,12) X ^DD("DD") S DIV=$P(DVB6,U,11)
S STAT=$P(DVB0,U,11) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
S OP=$P(DVB1,U,14) I OP="" S OP=" "
S ^TMP("CAPRI",MCNT)=" Hospital Summary: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
S Y=$P(DVB0,U,14) X ^DD("DD") S DIV=$P(DVB6,U,13)
S STAT=$P(DVB0,U,13) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
S OP=$P(DVB1,U,15) I OP="" S OP=" "
S ^TMP("CAPRI",MCNT)="21-day Certificate: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
S Y=$P(DVB1,U) X ^DD("DD") S DIV=$P(DVB6,U,15)
S STAT=$P(DVB0,U,15) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STATUS=" "
S OP=$P(DVB1,U,16) I OP="" S OP=" "
S ^TMP("CAPRI",MCNT)=" Other/Exam: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
S Y=$P(DVB1,U,3) X ^DD("DD") S DIV=$P(DVB6,U,17)
S STAT=$P(DVB0,U,17) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
S OP=$P(DVB1,U,17) I OP="" S OP=" "
S ^TMP("CAPRI",MCNT)=" Special Report: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
S Y=$P(DVB1,U,4) X ^DD("DD") S DIV=$P(DVB6,U,19)
S STAT=$P(DVB0,U,19) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
S OP=$P(DVB1,U,18) I OP="" S OP=" "
S ^TMP("CAPRI",MCNT)="Competency Report: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
S Y=$P(DVB1,U,5) X ^DD("DD") S DIV=$P(DVB6,U,21)
S STAT=$P(DVB0,U,21) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
S OP=$P(DVB2,U) I OP="" S OP=" "
S ^TMP("CAPRI",MCNT)=" Form 21-2680: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
S Y=$P(DVB1,U,6) X ^DD("DD") S DIV=$P(DVB6,U,23)
S STAT=$P(DVB0,U,23) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
S OP=$P(DVB2,U,2) I OP="" S OP=" "
S ^TMP("CAPRI",MCNT)="Asset Information: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
S Y=$P(DVB1,U,8) X ^DD("DD") S DIV=$P(DVB6,U,7)
S STAT=$P(DVB1,U,7) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
S OP=$P(DVB2,U,3) I OP="" S OP=" "
S ^TMP("CAPRI",MCNT)=" Admission Report: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
S Y=$P(DVB1,U,9) X ^DD("DD") S DIV=$P(DVB6,U,26)
S STAT=$P(DVB0,U,26) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
S OP=$P(DVB2,U,4) I OP="" S OP=" "
S ^TMP("CAPRI",MCNT)="OPT Treatment Rpt: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
S Y=$P(DVB1,U,10) X ^DD("DD") S DIV=$P(DVB6,U,28)
S STAT=$P(DVB0,U,28) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
S OP=$P(DVB2,U,5) I OP="" S OP=" "
S ^TMP("CAPRI",MCNT)=" Beg Date/Care: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
S ^TMP("CAPRI",MCNT)=""_"^",MCNT=MCNT+1
D REM
S ^TMP("CAPRI",MCNT)=""_"^"
S Y=$P(DVB1,U,12) X ^DD("DD")
S ^TMP("CAPRI",MCNT)="Requesting location: "_$E($P(DVB2,U,7),1,20)_" Date of Request: "_Y,MCNT=MCNT+1
S ^TMP("CAPRI",MCNT)=" Requested by: "_$E($P(DVB2,U,8),1,25)_" "_Y
S MSG=$NA(^TMP("CAPRI"))
;F S XX=$O(^TMP("CAPRI",XX)) Q:'XX S MSG(XX)=$G(^TMP("CAPRI",XX))
K Y,PTNAME,DFN,DVB0,DVB1,DVB2,DVB6
Q
REM S X=0,FLG=0
F S X=$O(^DVB(396,RECIEN,5,X)) Q:'X D
.I FLG=0 D
..S ^TMP("CAPRI",MCNT)="REMARKS: "_$G(^DVB(396,RECIEN,5,X,0))_"^",MCNT=MCNT+1
..S FLG=1
.I FLG=1&(X>1) D
..S ^TMP("CAPRI",MCNT)=$G(^DVB(396,RECIEN,5,X,0))_"^",MCNT=MCNT+1
S ^TMP("CAPRI",MCNT)=""_"^"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB71 5536 printed Dec 13, 2024@01:40:36 Page 2
DVBAB71 ;ALB/KLB - CAPRI REQUEST STATUS INQUIRY ;09/11/00;6/29/2023 @10:54AM
+1 ;;2.7;AMIE;**35,250**;Apr 10, 1995;Build 19
+2 ;
STRT(MSG,DFN,RECIEN) ;
+1 SET U="^"
+2 KILL ^TMP("CAPRI")
+3 IF '$DATA(DFN)
SET MSG(1)="You must select a patient."
+4 if '$DATA(DFN)
QUIT
+5 if DFN=""
QUIT
+6 SET PTNAME=$EXTRACT($PIECE(^DPT(DFN,0),U),1,25)
+7 ;S RECIEN=0,RECIEN=$O(^DVB(396,"B",DFN,RECIEN))
+8 SET DVB0=$GET(^DVB(396,RECIEN,0))
SET DVB1=$GET(^DVB(396,RECIEN,1))
SET DVB2=$GET(^DVB(396,RECIEN,2))
SET DVB6=$GET(^DVB(396,RECIEN,6))
+9 SET MCNT=1
+10 ;S ^TMP("CAPRI",MCNT)="Patient Name: "_PTNAME_"^",MCNT=MCNT+1
+11 IF $PIECE(DVB2,U,10)="L"
SET DOCTYP="ACTIVITY DATE: "
+12 IF $PIECE(DVB2,U,10)="A"
SET DOCTYP="Admission Date: "
+13 SET Y=$PIECE(DVB0,U,4)
XECUTE ^DD("DD")
+14 SET ^TMP("CAPRI",MCNT)=" Patient Name: "_PTNAME_" "_DOCTYP_Y_"^"
SET MCNT=MCNT+1
+15 ;S ^TMP("CAPRI",MCNT)="SSN: "_$P(^DPT(DFN,0),U,9)_"^",MCNT=MCNT+1
+16 ;CAPRI-4838
SET ^TMP("CAPRI",MCNT)=" SSN: "_$PIECE(^DPT(DFN,0),U,9)_" Claim Number: "_$PIECE($GET(^DPT(DFN,.31)),U,3)_"^"
SET MCNT=MCNT+1
+17 SET DIV=$PIECE(DVB2,U,9)
IF DIV'=""
SET DIV=$PIECE(^DG(40.8,DIV,0),U)
+18 SET ^TMP("CAPRI",MCNT)="Receiving Div: "_DIV_"^"
SET MCNT=MCNT+1
+19 SET ^TMP("CAPRI",MCNT)=" Requisition Status Status Date Operator Current Division"_"^"
SET MCNT=MCNT+1
+20 SET Y=$PIECE(DVB0,U,10)
XECUTE ^DD("DD")
SET DIV=$PIECE(DVB6,U,9)
SET STAT=$PIECE(DVB0,U,9)
IF STAT="P"
SET STAT="PENDING "
IF STAT="C"
SET STAT="COMPLETED "
IF STAT=""
SET STAT=" "
+21 IF DIV'=""
SET DIV=$PIECE(^DG(40.8,DIV,0),U)
+22 SET ^TMP("CAPRI",MCNT)="---------------------------------------------------------------------------"_"^"
SET MCNT=MCNT+1
+23 SET OP=$PIECE(DVB1,U,13)
IF OP=""
SET OP=" "
DATA SET ^TMP("CAPRI",MCNT)=" Notice/Discharge: "_STAT_Y_" "_OP_DIV_"^"
SET MCNT=MCNT+1
+1 SET Y=$PIECE(DVB0,U,12)
XECUTE ^DD("DD")
SET DIV=$PIECE(DVB6,U,11)
+2 SET STAT=$PIECE(DVB0,U,11)
IF STAT="P"
SET STAT="PENDING "
IF STAT="C"
SET STAT="COMPLETED "
IF STAT=""
SET STAT=" "
+3 SET OP=$PIECE(DVB1,U,14)
IF OP=""
SET OP=" "
+4 SET ^TMP("CAPRI",MCNT)=" Hospital Summary: "_STAT_Y_" "_OP_DIV_"^"
SET MCNT=MCNT+1
+5 SET Y=$PIECE(DVB0,U,14)
XECUTE ^DD("DD")
SET DIV=$PIECE(DVB6,U,13)
+6 SET STAT=$PIECE(DVB0,U,13)
IF STAT="P"
SET STAT="PENDING "
IF STAT="C"
SET STAT="COMPLETED "
IF STAT=""
SET STAT=" "
+7 SET OP=$PIECE(DVB1,U,15)
IF OP=""
SET OP=" "
+8 SET ^TMP("CAPRI",MCNT)="21-day Certificate: "_STAT_Y_" "_OP_DIV_"^"
SET MCNT=MCNT+1
+9 SET Y=$PIECE(DVB1,U)
XECUTE ^DD("DD")
SET DIV=$PIECE(DVB6,U,15)
+10 SET STAT=$PIECE(DVB0,U,15)
IF STAT="P"
SET STAT="PENDING "
IF STAT="C"
SET STAT="COMPLETED "
IF STAT=""
SET STATUS=" "
+11 SET OP=$PIECE(DVB1,U,16)
IF OP=""
SET OP=" "
+12 SET ^TMP("CAPRI",MCNT)=" Other/Exam: "_STAT_Y_" "_OP_DIV_"^"
SET MCNT=MCNT+1
+13 SET Y=$PIECE(DVB1,U,3)
XECUTE ^DD("DD")
SET DIV=$PIECE(DVB6,U,17)
+14 SET STAT=$PIECE(DVB0,U,17)
IF STAT="P"
SET STAT="PENDING "
IF STAT="C"
SET STAT="COMPLETED "
IF STAT=""
SET STAT=" "
+15 SET OP=$PIECE(DVB1,U,17)
IF OP=""
SET OP=" "
+16 SET ^TMP("CAPRI",MCNT)=" Special Report: "_STAT_Y_" "_OP_DIV_"^"
SET MCNT=MCNT+1
+17 SET Y=$PIECE(DVB1,U,4)
XECUTE ^DD("DD")
SET DIV=$PIECE(DVB6,U,19)
+18 SET STAT=$PIECE(DVB0,U,19)
IF STAT="P"
SET STAT="PENDING "
IF STAT="C"
SET STAT="COMPLETED "
IF STAT=""
SET STAT=" "
+19 SET OP=$PIECE(DVB1,U,18)
IF OP=""
SET OP=" "
+20 SET ^TMP("CAPRI",MCNT)="Competency Report: "_STAT_Y_" "_OP_DIV_"^"
SET MCNT=MCNT+1
+21 SET Y=$PIECE(DVB1,U,5)
XECUTE ^DD("DD")
SET DIV=$PIECE(DVB6,U,21)
+22 SET STAT=$PIECE(DVB0,U,21)
IF STAT="P"
SET STAT="PENDING "
IF STAT="C"
SET STAT="COMPLETED "
IF STAT=""
SET STAT=" "
+23 SET OP=$PIECE(DVB2,U)
IF OP=""
SET OP=" "
+24 SET ^TMP("CAPRI",MCNT)=" Form 21-2680: "_STAT_Y_" "_OP_DIV_"^"
SET MCNT=MCNT+1
+25 SET Y=$PIECE(DVB1,U,6)
XECUTE ^DD("DD")
SET DIV=$PIECE(DVB6,U,23)
+26 SET STAT=$PIECE(DVB0,U,23)
IF STAT="P"
SET STAT="PENDING "
IF STAT="C"
SET STAT="COMPLETED "
IF STAT=""
SET STAT=" "
+27 SET OP=$PIECE(DVB2,U,2)
IF OP=""
SET OP=" "
+28 SET ^TMP("CAPRI",MCNT)="Asset Information: "_STAT_Y_" "_OP_DIV_"^"
SET MCNT=MCNT+1
+29 SET Y=$PIECE(DVB1,U,8)
XECUTE ^DD("DD")
SET DIV=$PIECE(DVB6,U,7)
+30 SET STAT=$PIECE(DVB1,U,7)
IF STAT="P"
SET STAT="PENDING "
IF STAT="C"
SET STAT="COMPLETED "
IF STAT=""
SET STAT=" "
+31 SET OP=$PIECE(DVB2,U,3)
IF OP=""
SET OP=" "
+32 SET ^TMP("CAPRI",MCNT)=" Admission Report: "_STAT_Y_" "_OP_DIV_"^"
SET MCNT=MCNT+1
+33 SET Y=$PIECE(DVB1,U,9)
XECUTE ^DD("DD")
SET DIV=$PIECE(DVB6,U,26)
+34 SET STAT=$PIECE(DVB0,U,26)
IF STAT="P"
SET STAT="PENDING "
IF STAT="C"
SET STAT="COMPLETED "
IF STAT=""
SET STAT=" "
+35 SET OP=$PIECE(DVB2,U,4)
IF OP=""
SET OP=" "
+36 SET ^TMP("CAPRI",MCNT)="OPT Treatment Rpt: "_STAT_Y_" "_OP_DIV_"^"
SET MCNT=MCNT+1
+37 SET Y=$PIECE(DVB1,U,10)
XECUTE ^DD("DD")
SET DIV=$PIECE(DVB6,U,28)
+38 SET STAT=$PIECE(DVB0,U,28)
IF STAT="P"
SET STAT="PENDING "
IF STAT="C"
SET STAT="COMPLETED "
IF STAT=""
SET STAT=" "
+39 SET OP=$PIECE(DVB2,U,5)
IF OP=""
SET OP=" "
+40 SET ^TMP("CAPRI",MCNT)=" Beg Date/Care: "_STAT_Y_" "_OP_DIV_"^"
SET MCNT=MCNT+1
+41 SET ^TMP("CAPRI",MCNT)=""_"^"
SET MCNT=MCNT+1
+42 DO REM
+43 SET ^TMP("CAPRI",MCNT)=""_"^"
+44 SET Y=$PIECE(DVB1,U,12)
XECUTE ^DD("DD")
+45 SET ^TMP("CAPRI",MCNT)="Requesting location: "_$EXTRACT($PIECE(DVB2,U,7),1,20)_" Date of Request: "_Y
SET MCNT=MCNT+1
+46 SET ^TMP("CAPRI",MCNT)=" Requested by: "_$EXTRACT($PIECE(DVB2,U,8),1,25)_" "_Y
+47 SET MSG=$NAME(^TMP("CAPRI"))
+48 ;F S XX=$O(^TMP("CAPRI",XX)) Q:'XX S MSG(XX)=$G(^TMP("CAPRI",XX))
+49 KILL Y,PTNAME,DFN,DVB0,DVB1,DVB2,DVB6
+50 QUIT
REM SET X=0
SET FLG=0
+1 FOR
SET X=$ORDER(^DVB(396,RECIEN,5,X))
if 'X
QUIT
Begin DoDot:1
+2 IF FLG=0
Begin DoDot:2
+3 SET ^TMP("CAPRI",MCNT)="REMARKS: "_$GET(^DVB(396,RECIEN,5,X,0))_"^"
SET MCNT=MCNT+1
+4 SET FLG=1
End DoDot:2
+5 IF FLG=1&(X>1)
Begin DoDot:2
+6 SET ^TMP("CAPRI",MCNT)=$GET(^DVB(396,RECIEN,5,X,0))_"^"
SET MCNT=MCNT+1
End DoDot:2
End DoDot:1
+7 SET ^TMP("CAPRI",MCNT)=""_"^"
+8 QUIT
