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

BARDYSV5.m

Go to the documentation of this file. 
  1. BARDYSV5 ; IHS/SD/MAS,TPF - OMB - DAYS TO COLLECTION ; 02/09/2009
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**12,13,14,16,23**;OCT 26, 2005
  1.  ;
  1.  ; IHS/SD/TMM  07/02/2009  M1  Routine too large.  Create 2nd routine ^BARDYSV2
  1.  ; IHS/SD/TMM  09/17/2009  M2  Copy BARDYSVZ to BARDYSV3 for OMB Phase IBARTMP("BARDYSVZ",I modifications
  1.  ; IHS/SD/TMM  01/29/2010  M3  Tag TRANS moved from ^BARDYSV3 to ^BARDYSV5 due to 
  1.  ;                             routine size of ^BARDYSV3 and SAC checker requirement
  1.  ; IHS/SD/TMM  02/11/2010  M4  Use correct VISIT variable for BARMRG
  1.  ; FEB 2013 P.OTT CHANGED PTR TO INSURER TYPE
  1.  ; SEP 2013 P.OTT FIXED <UNDEF> IN INS TYPE (INSTYPX)
  1.  Q
  1.  ;
  1. VISITS(BARBEG,BAREND) ;EP - GET VISIT DATA
  1.  I $E(BAREND,6,7)="00" S $E(BAREND,6,7)="31"
  1.  S BAREND=BAREND_".24"
  1.  S BAROMY=$E(BARBEG,2,5)
  1.  S BARYR=$E(DT,1,3)
  1.  D NOW^%DTC
  1.  N CNT
  1.  S BEGIN=BARBEG-.01
  1.  S END=$P(BAREND,".",1)_".999999"
  1.  S VISIT=0 F CNT=1:1 S VISIT=$O(^AUPNVSIT(VISIT)) Q:'VISIT  D             ;M2
  1.  .S TMPBILL=""
  1.  .S TPBIEN="" F TMP=1:1 S TPBIEN=$O(^ABMDBILL(DUZ(2),"AV",VISIT,TPBIEN)) Q:'TPBIEN  D
  1.  ..S $P(TMPBILL,"|",TMP)=TPBIEN
  1.  .;M2 20091021 S BILLIEN=TMPBILL               ;Not sure how to handle multiple bills for 3PBIEN field  M2 20091025
  1.  .S BILLIEN=$P($G(TMPBILL),"|",1)              ;Not sure how to handle multiple bills for 3PBIEN field  M2 20091025
  1.  .;S MULTBILL=$S(TMPBILL["|":TMPBILL,1:"")     ;This for extra field at end of Visit Record
  1.  .S MULTBILL=TMPBILL                           ;This for extra field at end of Visit Record
  1.  .W:'$D(ZTQUEUED)&'(CNT#1000) "V"
  1.  .S VISCRDT=$P($$GET1^DIQ(9000010,VISIT,.02,"I"),".")  ;DATE VISIT CREATED          ;M2 20091008
  1.  .Q:VISCRDT<BARBEG                  ;M2 20091008
  1.  .Q:VISCRDT>END                     ;filter visits created after selection period
  1.  .S BARMY=($E(VISCRDT,1,3)+1700)_"-"_$E(VISCRDT,4,5)
  1.  .D VDATA                          ;M2
  1.  .I 'BARVDA S BARVDA=0
  1.  .D VREC                            ;Build Visit Record in ^BAROMB($J,
  1.  Q
  1.  ;
  1. GETV(VISIT) ;EP - Get Visit Variables
  1.  N BARVDA,VISITIEN
  1. VDATA ;EP - Visit Data
  1.  S VISITIEN=VISIT
  1.  S IENS=VISITIEN_","
  1.  S BARSCAT=$$SC^APCLV(VISITIEN,"I")                      ;API SERVICE CATEGORY
  1.  S BARSCAT=$$SC^APCLV(VISITIEN,"E")                      ;API SERVICE CATEGORY
  1.  S TMP=$G(^AUPNVSIT(VISITIEN,0))
  1.  S BARMRG=$P(TMP,"^",37)                                 ;M2 20091008
  1.  S VSITCRET=$P($$GET1^DIQ(9000010,IENS,.02,"I"),".")  ;DATE VISIT CREATED
  1.  S BARVADMT=$P($$GET1^DIQ(9000010,IENS,.01,"I"),".")  ;VISIT/ADMIT DATE&TIME
  1.  ;DETERMINE REVIEW DATE
  1.  S VPCCREV=$P($$GET1^DIQ(9000010,IENS,.13,"I"),".")   ;DATE LAST MODIFIED
  1.  S PCCREV=$$GEREV(VISITIEN,VPCCREV)  ;CHECK ALGORYTHM                            ;
  1.  ;END REVIEW DATE
  1.  S BARVTYP=$$GET1^DIQ(9000010,IENS,.03,"E")          ;TYPE (OF VISIT)
  1.  S BARVLOC=$$LOCENC^APCLV(VISITIEN,"C")              ;API LOC. OF ENCOUNTER ASUFAC
  1.  S BARLOCN=$$GET1^DIQ(9000010,IENS,.06,"E")       ;'LOC. OF ENCOUNTER' NAME
  1.  S:BARVLOC="" BARVLOC="UNDEF"
  1.  S BARVDEL=$$GET1^DIQ(9000010,IENS,.11,"I")      ;DELETE FLAG = 1 IF DELETED
  1.  S BARDEP=$$GET1^DIQ(9000010,IENS,.09)           ;DEPENDENT ENTRY COUNT - IF 0 THE VISIT SHOULD HAVE BEEN DELETED
  1.  S BARTPBF=$$GET1^DIQ(9000010,IENS,.04,"E")      ;THIRD PARTY BILLED (Visit has been billed)
  1.  S BARCS=$$CLINIC^APCLV(VISITIEN,"C")            ;CLINIC STOP (FOR
  1.  S BARVDA=VISITIEN
  1.  I BARVDA="" S BARVDA=0                          ;M2
  1.  Q
  1.  ;
  1. GEREV(BARVDA,VPCCREV) ;EP - GET LAST DATE 'REVIEWED'
  1.  ;PER DAVID BATTESE GET REVIEW DATE FROM V CHART AUDIT IF TURNED ON
  1.  N TMP,QUEAUDIT,EARLIEST
  1.  S QUEAUDIT=$$GET1^DIQ(9001000,DUZ(2)_",",.12,"I")  ;FIELD 'EHR/CHART AUDIT START DATE' FROM 'PCC MASTER CONTROL'
  1.  Q:BARVADMT<QUEAUDIT VPCCREV  ;IF ADMIT DATE IS BEFORE AUDIT WAS TURNED ON GET REVIEW DATE FROM 'DATE LAST MODIFIED'
  1.  D  ;OTHERWISE SEE IF YOU CAN GET IT IN THE 'V CHART AUDIT' FILE
  1.  .S (PCCREV,TMP)=""  ;^AUPNVCA = V CHART AUDIT
  1.  .F  S TMP=$O(^AUPNVCA("AD",BARVDA,TMP)) Q:'TMP  D
  1.  ..I $$GET1^DIQ(9000010.45,TMP_",",.04)="R" D      ;CHART AUDIT STATUS, R=REVIEWED/COMPLETE I=INCOMPLETE
  1.  ...S PCCREV=$$GET1^DIQ(9000010.45,BARVDA_",",.01)  ;DATE OF AUDIT
  1.  I PCCREV S PCCREV=PCCREV_"A"  ;IF A "R" DATE OF AUDIT WAS FOUND THEN USE IT
  1.  E  S PCCREV=VPCCREV_"V"       ;OTHERWISE STAY WITH THE 'DATE LAST MODIFIED'
  1.  Q PCCREV
  1.  ;
  1. VREC ;EP - SET THE VISIT AND BILL RECORDS SORTED BY VISIT
  1.  N VISITREC,BILLREC,RECHDR,TRANREC
  1.  S (BILLREC,VISITREC)=""
  1.  S RECHDR=BARVLOC_U_BILLIEN_U_$S($G(BARMY)'="":BARMY,1:0)
  1.  ;
  1.  I '$D(^BAROMB($J,BARVLOC,BARVDA,"A VISITREC")) D
  1.  .S VISITREC=RECHDR_U_BARVDA              ;VISIT IEN                 ;M2 20090930
  1.  .S VISITREC=VISITREC_U_BARSCAT           ;'SERVICE CATEGORY'        ;M2 20090930
  1.  .S VISITREC=VISITREC_U_BARVTYP           ;'VISIT TYPE'              
  1.  .S VISITREC=VISITREC_U_$G(VSITCRET)      ;'DATE VISIT CREATED'
  1.  .S VISITREC=VISITREC_U_$G(BARVADMT)      ;'VISIT/ADMIT DATE&TIME'
  1.  .S VISITREC=VISITREC_U_$G(PCCREV)        ;"VISIT REVIEWED DATE" SEE $$GETREV
  1.  .S VISITREC=VISITREC_U_BARLOCN           ;'LOC. OF ENCOUNTER' - NAME
  1.  .S VISITREC=VISITREC_U_BARMRG            ;'MERGED TO'
  1.  .S VISITREC=VISITREC_U_BARVDEL           ;'DELETE FLAG'             ;M2 20090930
  1.  .S VISITREC=VISITREC_U_BARDEP            ;'DEPENDENT ENTRY COUNT'   ;M2 20090930
  1.  .S VISITREC=VISITREC_U_BARCS             ;CLINIC STOP               ;M2 20091008
  1.  .;Verify IHS AFFILIATION
  1.  .N REC                                                              ;M2 20091008
  1.  .S REC=$O(^AUTTLOC(DUZ(2),11,""),-1)                                ;M2 20091008
  1.  .S AFFIL=$$GET1^DIQ(9999999.0611,REC_","_DUZ(2)_",",.03,"I")        ;M2 20091008
  1.  .S VISITREC=VISITREC_U_AFFIL             ;ADD AFFIL AND IHS CODES TO VISIT REC  ;M2 20091008
  1.  .S VISITREC=VISITREC_U_MULTBILL          ;Multiple 3PBills per Visit ;M2 20091015
  1.  .;
  1.  .S ^BAROMB($J,BARVLOC,BARVDA,"A VISITREC")="V"_U_VISITREC
  1.  .S TEMP=$G(^BARTMP("BARDYSV3",$J,"A_VISITREC"))+1
  1.  .S ^BARTMP("BARDYSV3",$J,"A_VISITREC")=TMP
  1.  .S ^BARTMP("BARDYSV3",$J,"A_VISITREC",TMP)="V"_U_VISITREC
  1.  .S ^BARTMP("BARDYSV3",0,20,BARVLOC,"V")=$G(^BARTMP("BARDYSV3",0,20,BARVLOC,"V"))+1
  1.  I BARCS="" D  Q                         ;IF NO CLINIC, NO BILL SO DO NOT INCLUDE. INCLUDE PER MARSHA
  1.  .S BARVDA=0
  1.  .S TMP=$G(^BARTMP("BARDYSV3",1,"VISITS SCREENED FOR CLINIC STOP"))+1     ;M2 20091006
  1.  .S ^BARTMP("BARDYSV3",1,"VISITS SCREENED FOR CLINIC STOP")=TMP           ;M2 20091006
  1.  .S TMPREC=$G(VISITIEN)_"^"_$G(BARVTYP)_"^"_BARLOCN_"^"_$G(BARCS)         ;M2 20091006 20091008
  1.  .S TMPREC=TMPREC_"^"_$G(BARVLOC)_U_$G(VISCRDT)_U_$G(END)_U_$G(BEGIN)     ;M2 20091008
  1.  .S TMPREC=TMPREC_"^"_$G(VISITREC)                                        ;M2 20091008
  1.  .S ^BARTMP("BARDYSV3",1,"VISITS SCREENED FOR CLINIC STOP",TMP,0)=TMPREC    ;M2 20091006
  1.  Q
  1.  ;
  1. TRANS(BARBEG,BAREND) ;EP - Find the A/R Transactions for this period   ;M3*ADD*TMM
  1.  S BEGIN=BARBEG-.01
  1.  S END=BAREND_".999999"
  1.  N CNT
  1.  S BARTRIEN=BEGIN F CNT=1:1 S BARTRIEN=$O(^BARTR(DUZ(2),BARTRIEN)) Q:('BARTRIEN)!(BARTRIEN>END)  D     ;A/R TRANS DT/TM
  1.  . I DUZ=902 W !,CNT,". ",BARTRIEN
  1.  .W:'$D(ZTQUEUED)&'(CNT#1000) "T"
  1.  .S BARTR0=$G(^BARTR(DUZ(2),BARTRIEN,0))
  1.  .S BARTR1=$G(^BARTR(DUZ(2),BARTRIEN,1))
  1.  .S BARVLOC=$P(BARTR0,U,11)         ;Visit Location
  1.  .S BARBL=$P(BARTR0,U,4)            ;A/R Bill IEN
  1.  .I BARBL="" D  Q
  1.  ..S ^BARTMP("BARDYSVZ","TRANS MISSING ARBILL")=DUZ(2)_U_$G(BARTRIEN)_"---"_$G(BARTR0)
  1.  .S BARBL0=$G(^BARBL(DUZ(2),BARBL,0))
  1.  .S BILLIEN=$P(BARBL0,U,17)
  1.  .S TPBDUZ2=$P(BARBL0,U,22)
  1.  .;get the Visit data for record header
  1.  .I TPBDUZ2="" S TPBDUZ2=0   ;just in case... send data anyway for testing
  1.  .I BILLIEN="" S BILLIEN=0   ;just in case... send data anyway for testing
  1.  .S VISIT=0,VISIT=$O(^ABMDBILL(TPBDUZ2,BILLIEN,11,VISIT))     ;PCC VISIT IEN
  1.  .Q:'VISIT
  1.  .S BARVLOC=$$LOCENC^APCLV(VISIT,"C")        ;API LOC. OF ENCOUNTER ASUFAC ;M2
  1.  .S:BARVLOC="" BARVLOC="UNDEF"                                             ;M2
  1.  .S BARVDA=VISIT                             ;Get visit data
  1.  .S:BARVDA="" BARVDA=0                                                     ;M2
  1.  .S VISCRDT=$P($$GET1^DIQ(9000010,VISIT,.02,"I"),".")  ;DATE VISIT CREATED        ;M2 20091008
  1.  .Q:VISCRDT<3081001               ;filter Visits created prior to 10/1/08
  1.  .S BARMY=($E(VISCRDT,1,3)+1700)_"-"_$E(VISCRDT,4,5)
  1.  .S IENS=VISIT_","
  1.  .;S TMP=$G(^AUPNVSIT(VISITIEN,0))                        ;M2 20091015 ;M4*DEL*TMM
  1.  .S TMP=$G(^AUPNVSIT(VISIT,0))                            ;M2 20091015 ;M4*ADD*TMM
  1.  .S BARMRG=$P(TMP,"^",37)                                 ;M2 20091015
  1.  .S BARVDEL=$$GET1^DIQ(9000010,IENS,.11,"I")    ;DELETE FLAG = 1 IF DELETED   ;M2 20090930
  1.  .S BARDEP=$$GET1^DIQ(9000010,IENS,.09)         ;DEPENDENT ENTRY COUNT - IF 0 THE VISIT SHOULD HAVE BEEN DELETED  ;M2 20090930
  1.  .S RECHDR=BARVLOC_U_BILLIEN_U_$S($G(BARMY)'="":BARMY,1:0)
  1.  .;
  1.  .;Get A/R transaction data
  1.  .S TRANDATE=BARTRIEN
  1.  .S IENS=BARTRIEN_","
  1.  .I $$GET1^DIQ(90050.03,IENS,7,"I")="Y" Q      ;'MESSAGE' IF YES SCREEN OUT PER MEETING 4/7/2009
  1.  .S INSURER=$$GET1^DIQ(90050.03,IENS,6,"E")    ;'A/R ACCOUNT'
  1.  .S INSPTR=$$GET1^DIQ(90050.03,IENS,6,"I")     ;'A/R ACCOUNT' PTR
  1.  .S TRANTYP=$$GET1^DIQ(90050.03,IENS,101,"E")  ;'TRANSACTION TYPE'
  1.  .S CREDDEB=$$GET1^DIQ(90050.03,IENS,3.5,"I")  ;'CREDIT / DEBIT'
  1.  .S ADJCAT=$$GET1^DIQ(90050.03,IENS,102,"E")   ;'ADJUSTMENT CATEGORY'
  1.  .S ADJTYP=$$GET1^DIQ(90050.03,IENS,103,"E")   ;'ADJUSTMENT TYPE'
  1.  .S ARBILL=$$GET1^DIQ(90050.03,IENS,4,"I")     ;'PTR TO A/R BILL'
  1.  .S CURAMT=$$GET1^DIQ(90050.01,ARBILL_",",15,"I")  ;'CURRENT BILL' AMOUNT IN 'A/R BILL'
  1.  .I CURAMT="" S CURAMT="null"
  1.  .S D0=INSPTR,INSTYP=$$VALI^BARVPM(8) ;AR ACCNR NUMBER-->^P
  1.  .I INSTYP="I" S ^BARTMP("BARDYSV3",1,"TXS SCREENED FOR INSTYP=I")=$G(^BARTMP("BARDYSV3",1,"TXS SCREENED FOR INSTYP=I"))+1
  1.  .S IENS=VISIT_","                                              ;M2 20090930
  1.  .S SAVEDUZ=DUZ(2)                                              ;M4*ADD*TMM
  1.  .S BILLSTA=$$GET1^DIQ(9002274.4,IENS,.04,"E")   ;BILL STATUS   ;M2 20090930
  1.  .S DUZ(2)=SAVEDUZ                                              ;M4*ADD*TMM
  1.  .;Write Transaction record
  1.  .I '$D(^BAROMB($J,BARVLOC,BARVDA,"TRANS REC",TRANDATE)) D
  1.  ..S RECHDR=BARVLOC_U_BILLIEN_U_$S($G(BARMY)'="":BARMY,1:0)          ;Transaction Record Header
  1.  ..S TRANREC="T"_U_RECHDR_U_TRANDATE
  1.  ..S TRANREC=TRANREC_U_INSURER
  1.  ..S TRANREC=TRANREC_U_TRANTYP
  1.  ..S TRANREC=TRANREC_U_$P(TRANDATE,".")
  1.  ..S TRANREC=TRANREC_U_CREDDEB
  1.  ..S TRANREC=TRANREC_U_ADJCAT
  1.  ..S TRANREC=TRANREC_U_ADJTYP
  1.  ..S TRANREC=TRANREC_U_CURAMT
  1.  ..S TRANREC=TRANREC_U_INSTYP                ;M2 20090930
  1.  ..S TRANREC=TRANREC_U_BARMRG                ;M2 20090930
  1.  ..S TRANREC=TRANREC_U_BARVDEL               ;M2 20090930
  1.  ..S TRANREC=TRANREC_U_BARDEP                ;M2 20090930
  1.  ..S ^BAROMB($J,BARVLOC,BILLIEN,"TRANS REC",TRANDATE)=TRANREC
  1.  ..S TMP=$G(^BARTMP("BARDYSV3",$J,"TRANS_REC"))+1
  1.  ..S ^BARTMP("BARDYSV3",$J,"TRANS_REC")=TMP
  1.  ..S ^BARTMP("BARDYSV3",$J,"TRANS_REC",TMP)=TRANREC
  1.  ..S ^BARTMP("BARDYSV3",0,20,BARVLOC,"T")=$G(^BARTMP("BARDYSV3",0,20,BARVLOC,"T"))+1
  1.  Q