DVBABEBD ;ALB - CAPRI EXAM BY DATE REPORT;09/13/04 ; 2/10/11 12:12pm
;;2.7;AMIE;**57,108,185,190,192,193**;Apr 10, 1995;Build 84
;ALB/RTW - 192 added Claim Type,and Special Consideration(s)
Q
;
EXAMBYDT(MSG,BEGDT,ENDDT,DVBADLMTR) ; CALLED BY REMOTE PROCEDURE DVBAB EXAMS BY DATE
N DVBABCNT,DVBABIEN,DVBABPAT,DVBABT,DVBAB0,DVBABT1,DVBABT2,DVBABT3,DVBABT4,DVBABT5,DVBABT6,DFN
N DVBAA,DVBCNT,DVBX,DVBAD,DVBCTN,DVBCTW,DVBSC,DVBSCC,DVBSCN,DVBSCNS,DVBSCW,DVBSCWA,VADM
; GRE; Reroute information added to report and CSV file
N RRIENINC,RRSTATINC,RRSTAT,RRDATE,RRTOSITE,RRFRMSITE,RRSTATDTE
S DVBADLMTR=$S($G(DVBADLMTR)=1:",",1:0)
S DVBAD=DVBADLMTR
; AJF ; Request Status Conversion; removed call to SETSTAT
K ^TMP("DVBABEBD",DUZ)
I $G(DVBAD)="," D
. S ^TMP("DVBABEBD",DUZ,1)="SSN"_DVBAD_"PATIENT NAME"_DVBAD_"REQUEST DATE"_DVBAD_"DATE RELEASED"_DVBAD_"DATE PRINTED BY RO"_DVBAD_"REQUEST STATUS"_DVBAD_"CLAIM TYPE"_DVBAD_"SPECIAL CONSIDERATION(S)"_$C(13)
S DVBABCNT=$S(DVBAD'=",":1,1:2),DVBABIEN=0,MSG=$NA(^TMP("DVBABEBD",DUZ))
F S DVBABIEN=$O(^DVB(396.3,DVBABIEN)) Q:+DVBABIEN=0 D
. ;REQUEST DATE
. S DVBAB0=$G(^DVB(396.3,DVBABIEN,0)) Q:DVBAB0=""
. S DVBABPAT=$G(^DPT($P(DVBAB0,"^"),0)) Q:DVBABPAT=""
. S DVBABT2=$P($P(DVBAB0,"^",2),".")
. I (DVBABT2>(BEGDT-1))&(DVBABT2<(ENDDT+1)) D
.. S DVBABT1=$P(DVBABPAT,"^",1) ;PATIENT NAME
.. S DFN=$P(DVBAB0,"^") D DEM^VADPT I $G(VADM(1))'="" S DVBABT6=$S($G(DVBAD)=",":$P($G(VADM(2)),U,2),1:$P($G(VADM(2)),U,1)) ;SSN
.. S DVBABT3=$P($P(DVBAB0,"^",14),".") ;DATE RELEASED
.. S DVBABT4=$P($P(DVBAB0,"^",16),".") ;DATE PRINTED BY RO
.. S DVBABT5=$P(DVBAB0,"^",18) ;REQUEST STATUS
.. S (DVBCTW,DVBSCWA)="" D CLAIMTYP,SPEC
.. ;AJF ; Request Status Conversion
.. S DVBABT5=$$RTSTAT^DVBCUTL8(DVBABT5)
.. S DVBABT2=$$FMTE^XLFDT(DVBABT2,"5DZ"),DVBABT3=$$FMTE^XLFDT(DVBABT3,"5DZ"),DVBABT4=$$FMTE^XLFDT(DVBABT4,"5DZ")
.. I $G(DVBAD)'="," S ^TMP("DVBABEBD",DUZ,DVBABCNT)=DVBABT1_U_DVBABT2_U_DVBABT3_U_DVBABT4_U_DVBABT5_U_DVBABT6_U_DVBCTW_U_DVBSCWA_$C(13)
.. I $G(DVBAD)="," S ^TMP("DVBABEBD",DUZ,DVBABCNT)=DVBABT6_DVBADLMTR_""""_DVBABT1_""""_DVBADLMTR_$$FMTE^XLFDT(DVBABT2,"5DZ")_DVBADLMTR_$$FMTE^XLFDT(DVBABT3,"5DZ")_DVBADLMTR_$$FMTE^XLFDT(DVBABT4,"5DZ") D
.. .S ^TMP("DVBABEBD",DUZ,DVBABCNT)=^TMP("DVBABEBD",DUZ,DVBABCNT)_DVBADLMTR_""""_DVBABT5_""""_DVBAD_""""_DVBCTW_""""_DVBAD_""""_DVBSCWA_""""_$C(13)
.. S DVBABCNT=DVBABCNT+1
Q
;
CLAIMTYP ;THE CLAIM TYPE OF A 2507 REQUEST
S DVBCTW=""
Q:'$D(^DVB(396.3,DVBABIEN,9,0))
;DVBIEN is the 2507 REQUEST FILE IEN
;DVBCTW is the string /name of the CLAIM TYPE
D GETS^DIQ(396.3,DVBABIEN_",","9.1*","E","MSG","ERR")
S DVBCTW=MSG("396.32","1,"_DVBABIEN_",",".01","E")
Q
;
SPEC ;SPECIAL CONSIDERATION(S) FOR A 2507 REQUEST
K DVBSCW
S DVBSCWA=""
Q:'$D(^DVB(396.3,DVBABIEN,8))
;DVBABIEN is the 2507 REQUEST FILE IEN
;DVBSC is a the SPECIAL CONSIDERATION entry for the 2507 REQUEST
;DVBSCN is the pointer number to the SPECIAL CONSIDERATION file 396.25
;DVBSCW is the string /name of the SPECIAL CONSIDERATION
S DVBAA=$P(^DVB(396.3,DVBABIEN,8,0),U,4)
S (DVBSC,DVBCNT)=0 F S DVBSC=$O(^DVB(396.3,DVBABIEN,8,DVBSC)) Q:'DVBSC D
.S DVBSCN=$P(^DVB(396.3,DVBABIEN,8,DVBSC,0),U,1)
.S DVBSCW(DVBSC)=$G(^DVB(396.25,DVBSCN,0))
.S DVBCNT=DVBCNT+1
.I (DVBCNT'=DVBAA) S:$D(DVBSCW(DVBSC)) DVBSCW(DVBSC)=DVBSCW(DVBSC)_","
S DVBX="" F S DVBX=$O(DVBSCW(DVBX)) Q:'DVBX S DVBSCWA=DVBSCWA_DVBSCW(DVBX)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBABEBD 3478 printed Nov 22, 2024@16:51:03 Page 2
DVBABEBD ;ALB - CAPRI EXAM BY DATE REPORT;09/13/04 ; 2/10/11 12:12pm
+1 ;;2.7;AMIE;**57,108,185,190,192,193**;Apr 10, 1995;Build 84
+2 ;ALB/RTW - 192 added Claim Type,and Special Consideration(s)
+3 QUIT
+4 ;
EXAMBYDT(MSG,BEGDT,ENDDT,DVBADLMTR) ; CALLED BY REMOTE PROCEDURE DVBAB EXAMS BY DATE
+1 NEW DVBABCNT,DVBABIEN,DVBABPAT,DVBABT,DVBAB0,DVBABT1,DVBABT2,DVBABT3,DVBABT4,DVBABT5,DVBABT6,DFN
+2 NEW DVBAA,DVBCNT,DVBX,DVBAD,DVBCTN,DVBCTW,DVBSC,DVBSCC,DVBSCN,DVBSCNS,DVBSCW,DVBSCWA,VADM
+3 ; GRE; Reroute information added to report and CSV file
+4 NEW RRIENINC,RRSTATINC,RRSTAT,RRDATE,RRTOSITE,RRFRMSITE,RRSTATDTE
+5 SET DVBADLMTR=$SELECT($GET(DVBADLMTR)=1:",",1:0)
+6 SET DVBAD=DVBADLMTR
+7 ; AJF ; Request Status Conversion; removed call to SETSTAT
+8 KILL ^TMP("DVBABEBD",DUZ)
+9 IF $GET(DVBAD)=","
Begin DoDot:1
+10 SET ^TMP("DVBABEBD",DUZ,1)="SSN"_DVBAD_"PATIENT NAME"_DVBAD_"REQUEST DATE"_DVBAD_"DATE RELEASED"_DVBAD_"DATE PRINTED BY RO"_DVBAD_"REQUEST STATUS"_DVBAD_"CLAIM TYPE"_DVBAD_"SPECIAL CONSIDERATION(S)"_$CHAR(13)
End DoDot:1
+11 SET DVBABCNT=$SELECT(DVBAD'=",":1,1:2)
SET DVBABIEN=0
SET MSG=$NAME(^TMP("DVBABEBD",DUZ))
+12 FOR
SET DVBABIEN=$ORDER(^DVB(396.3,DVBABIEN))
if +DVBABIEN=0
QUIT
Begin DoDot:1
+13 ;REQUEST DATE
+14 SET DVBAB0=$GET(^DVB(396.3,DVBABIEN,0))
if DVBAB0=""
QUIT
+15 SET DVBABPAT=$GET(^DPT($PIECE(DVBAB0,"^"),0))
if DVBABPAT=""
QUIT
+16 SET DVBABT2=$PIECE($PIECE(DVBAB0,"^",2),".")
+17 IF (DVBABT2>(BEGDT-1))&(DVBABT2<(ENDDT+1))
Begin DoDot:2
+18 ;PATIENT NAME
SET DVBABT1=$PIECE(DVBABPAT,"^",1)
+19 ;SSN
SET DFN=$PIECE(DVBAB0,"^")
DO DEM^VADPT
IF $GET(VADM(1))'=""
SET DVBABT6=$SELECT($GET(DVBAD)=",":$PIECE($GET(VADM(2)),U,2),1:$PIECE($GET(VADM(2)),U,1))
+20 ;DATE RELEASED
SET DVBABT3=$PIECE($PIECE(DVBAB0,"^",14),".")
+21 ;DATE PRINTED BY RO
SET DVBABT4=$PIECE($PIECE(DVBAB0,"^",16),".")
+22 ;REQUEST STATUS
SET DVBABT5=$PIECE(DVBAB0,"^",18)
+23 SET (DVBCTW,DVBSCWA)=""
DO CLAIMTYP
DO SPEC
+24 ;AJF ; Request Status Conversion
+25 SET DVBABT5=$$RTSTAT^DVBCUTL8(DVBABT5)
+26 SET DVBABT2=$$FMTE^XLFDT(DVBABT2,"5DZ")
SET DVBABT3=$$FMTE^XLFDT(DVBABT3,"5DZ")
SET DVBABT4=$$FMTE^XLFDT(DVBABT4,"5DZ")
+27 IF $GET(DVBAD)'=","
SET ^TMP("DVBABEBD",DUZ,DVBABCNT)=DVBABT1_U_DVBABT2_U_DVBABT3_U_DVBABT4_U_DVBABT5_U_DVBABT6_U_DVBCTW_U_DVBSCWA_$CHAR(13)
+28 IF $GET(DVBAD)=","
SET ^TMP("DVBABEBD",DUZ,DVBABCNT)=DVBABT6_DVBADLMTR_""""_DVBABT1_""""_DVBADLMTR_$$FMTE^XLFDT(DVBABT2,"5DZ")_DVBADLMTR_$$FMTE^XLFDT(DVBABT3,"5DZ")_DVBADLMTR_$$FMTE^XLFDT(DVBABT4,"5DZ")
Begin DoDot:3
+29 SET ^TMP("DVBABEBD",DUZ,DVBABCNT)=^TMP("DVBABEBD",DUZ,DVBABCNT)_DVBADLMTR_""""_DVBABT5_""""_DVBAD_""""_DVBCTW_""""_DVBAD_""""_DVBSCWA_""""_$CHAR(13)
End DoDot:3
+30 SET DVBABCNT=DVBABCNT+1
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
CLAIMTYP ;THE CLAIM TYPE OF A 2507 REQUEST
+1 SET DVBCTW=""
+2 if '$DATA(^DVB(396.3,DVBABIEN,9,0))
QUIT
+3 ;DVBIEN is the 2507 REQUEST FILE IEN
+4 ;DVBCTW is the string /name of the CLAIM TYPE
+5 DO GETS^DIQ(396.3,DVBABIEN_",","9.1*","E","MSG","ERR")
+6 SET DVBCTW=MSG("396.32","1,"_DVBABIEN_",",".01","E")
+7 QUIT
+8 ;
SPEC ;SPECIAL CONSIDERATION(S) FOR A 2507 REQUEST
+1 KILL DVBSCW
+2 SET DVBSCWA=""
+3 if '$DATA(^DVB(396.3,DVBABIEN,8))
QUIT
+4 ;DVBABIEN is the 2507 REQUEST FILE IEN
+5 ;DVBSC is a the SPECIAL CONSIDERATION entry for the 2507 REQUEST
+6 ;DVBSCN is the pointer number to the SPECIAL CONSIDERATION file 396.25
+7 ;DVBSCW is the string /name of the SPECIAL CONSIDERATION
+8 SET DVBAA=$PIECE(^DVB(396.3,DVBABIEN,8,0),U,4)
+9 SET (DVBSC,DVBCNT)=0
FOR
SET DVBSC=$ORDER(^DVB(396.3,DVBABIEN,8,DVBSC))
if 'DVBSC
QUIT
Begin DoDot:1
+10 SET DVBSCN=$PIECE(^DVB(396.3,DVBABIEN,8,DVBSC,0),U,1)
+11 SET DVBSCW(DVBSC)=$GET(^DVB(396.25,DVBSCN,0))
+12 SET DVBCNT=DVBCNT+1
+13 IF (DVBCNT'=DVBAA)
if $DATA(DVBSCW(DVBSC))
SET DVBSCW(DVBSC)=DVBSCW(DVBSC)_","
End DoDot:1
+14 SET DVBX=""
FOR
SET DVBX=$ORDER(DVBSCW(DVBX))
if 'DVBX
QUIT
SET DVBSCWA=DVBSCWA_DVBSCW(DVBX)
+15 QUIT
+16 ;
