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