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

DVBABEBD.m

Go to the documentation of this file. 
  1. 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
  1.  ;ALB/RTW - 192 added Claim Type,and Special Consideration(s)
  1.  Q
  1.  ;
  1. EXAMBYDT(MSG,BEGDT,ENDDT,DVBADLMTR) ; CALLED BY REMOTE PROCEDURE DVBAB EXAMS BY DATE
  1.  N DVBABCNT,DVBABIEN,DVBABPAT,DVBABT,DVBAB0,DVBABT1,DVBABT2,DVBABT3,DVBABT4,DVBABT5,DVBABT6,DFN
  1.  N DVBAA,DVBCNT,DVBX,DVBAD,DVBCTN,DVBCTW,DVBSC,DVBSCC,DVBSCN,DVBSCNS,DVBSCW,DVBSCWA,VADM
  1.  ; GRE;  Reroute information added to report and CSV file
  1.  N RRIENINC,RRSTATINC,RRSTAT,RRDATE,RRTOSITE,RRFRMSITE,RRSTATDTE
  1.  S DVBADLMTR=$S($G(DVBADLMTR)=1:",",1:0)
  1.  S DVBAD=DVBADLMTR
  1.  ; AJF ; Request Status Conversion; removed call to SETSTAT 
  1.  K ^TMP("DVBABEBD",DUZ)
  1.  I $G(DVBAD)="," D
  1.  . 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)
  1.  S DVBABCNT=$S(DVBAD'=",":1,1:2),DVBABIEN=0,MSG=$NA(^TMP("DVBABEBD",DUZ))
  1.  F  S DVBABIEN=$O(^DVB(396.3,DVBABIEN)) Q:+DVBABIEN=0  D
  1.  . ;REQUEST DATE
  1.  . S DVBAB0=$G(^DVB(396.3,DVBABIEN,0)) Q:DVBAB0=""
  1.  . S DVBABPAT=$G(^DPT($P(DVBAB0,"^"),0)) Q:DVBABPAT=""
  1.  . S DVBABT2=$P($P(DVBAB0,"^",2),".")
  1.  . I (DVBABT2>(BEGDT-1))&(DVBABT2<(ENDDT+1)) D
  1.  .. S DVBABT1=$P(DVBABPAT,"^",1) ;PATIENT NAME
  1.  .. 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
  1.  .. S DVBABT3=$P($P(DVBAB0,"^",14),".") ;DATE RELEASED
  1.  .. S DVBABT4=$P($P(DVBAB0,"^",16),".") ;DATE PRINTED BY RO
  1.  .. S DVBABT5=$P(DVBAB0,"^",18) ;REQUEST STATUS
  1.  .. S (DVBCTW,DVBSCWA)="" D CLAIMTYP,SPEC
  1.  .. ;AJF ; Request Status Conversion
  1.  .. S DVBABT5=$$RTSTAT^DVBCUTL8(DVBABT5)
  1.  .. S DVBABT2=$$FMTE^XLFDT(DVBABT2,"5DZ"),DVBABT3=$$FMTE^XLFDT(DVBABT3,"5DZ"),DVBABT4=$$FMTE^XLFDT(DVBABT4,"5DZ")
  1.  .. 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)
  1.  .. 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
  1.  .. .S ^TMP("DVBABEBD",DUZ,DVBABCNT)=^TMP("DVBABEBD",DUZ,DVBABCNT)_DVBADLMTR_""""_DVBABT5_""""_DVBAD_""""_DVBCTW_""""_DVBAD_""""_DVBSCWA_""""_$C(13)
  1.  .. S DVBABCNT=DVBABCNT+1
  1.  Q
  1.  ;
  1. CLAIMTYP ;THE CLAIM TYPE OF A 2507 REQUEST
  1.  S DVBCTW=""
  1.  Q:'$D(^DVB(396.3,DVBABIEN,9,0))
  1.  ;DVBIEN is the 2507 REQUEST FILE IEN
  1.  ;DVBCTW is the string /name of the CLAIM TYPE
  1.  D GETS^DIQ(396.3,DVBABIEN_",","9.1*","E","MSG","ERR")
  1.  S DVBCTW=MSG("396.32","1,"_DVBABIEN_",",".01","E")
  1.  Q
  1.  ;
  1. SPEC ;SPECIAL CONSIDERATION(S) FOR A 2507 REQUEST
  1.  K DVBSCW
  1.  S DVBSCWA=""
  1.  Q:'$D(^DVB(396.3,DVBABIEN,8))
  1.  ;DVBABIEN is the 2507 REQUEST FILE IEN
  1.  ;DVBSC is a the SPECIAL CONSIDERATION entry for the 2507 REQUEST
  1.  ;DVBSCN is the pointer number to the SPECIAL CONSIDERATION file 396.25
  1.  ;DVBSCW is the string /name of the SPECIAL CONSIDERATION
  1.  S DVBAA=$P(^DVB(396.3,DVBABIEN,8,0),U,4)
  1.  S (DVBSC,DVBCNT)=0 F  S DVBSC=$O(^DVB(396.3,DVBABIEN,8,DVBSC)) Q:'DVBSC  D
  1.  .S DVBSCN=$P(^DVB(396.3,DVBABIEN,8,DVBSC,0),U,1)
  1.  .S DVBSCW(DVBSC)=$G(^DVB(396.25,DVBSCN,0))
  1.  .S DVBCNT=DVBCNT+1
  1.  .I (DVBCNT'=DVBAA) S:$D(DVBSCW(DVBSC)) DVBSCW(DVBSC)=DVBSCW(DVBSC)_","
  1.  S DVBX="" F  S DVBX=$O(DVBSCW(DVBX)) Q:'DVBX  S DVBSCWA=DVBSCWA_DVBSCW(DVBX)
  1.  Q
  1.  ;