BARDYSV8 ; IHS/SD/TPF - DAYS IN A/R REPORT CALLS ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**28**;OCT 26,2005;Build 92
;IHS/SD/POT-1.8*23-FEB 2013 CHANGED PTR TO INSURER TYPE
;IHS/SD/POT-1.8*23-APR 2013 RESOLVED NIL VALUES OF INSTYP AND ACTINS
;IHS/SD/SDR-1.8*28-Updated p23 documentation
;IHS/SD/SDR-1.8*28-Spint from
;IHS/SD/SDR-1.8*28-CR8345 HEAT224215 - Added code to look thru DUZ(2)s in 3P Bill file for visit IEN. Changed couple FM calls to be straight code.
; Lookups were failing due to multiple DUZ(2)s. Captured detail in "DET" subscript for detail report. Added code to populate last
; pymt all the time; was only populated if multiple pymts were made.
Q
FIRLSTPY(BILL3P) ;EP - FIND FIRST-LAST PAYMENT MADE IN TRANS FILE
;N RETURN,TRANIEN,BILLAR,FIRST,LAST ;bar*1.8*28 CR8345 HEAT224215
;S BILL3P=BILL3P_" ",FIRST=0,LAST=0 ;bar*1.8*28 CR8345 HEAT224215
S BILL3P=BILL3P_" " ;bar*1.8*28 CR8345 HEAT224215
;FIND AR BILL IEN CORRESPONDING TO 3P BILL IEN USING ACTUAL BILL NUMBER
S BILLAR=$O(^BARBL(DUZ(2),"B",BILL3P))
Q:BILLAR="" DT_U_DT_U_DT
S BILLARIE=$O(^BARBL(DUZ(2),"B",BILLAR,""))
S TRANIEN=""
F S TRANIEN=$O(^BARTR(DUZ(2),"AC",BILLARIE,TRANIEN)) Q:TRANIEN="" D
.;NOW FIND FIRST PYMT TRANS
.;IF FIELD #101 'TRANS TYPE' = 'PYMT' AND
.;'CREDIT' FIELD #2 IS NOT NULL THEN GET EARLIEST DATE
.Q:$$GET1^DIQ(90050.03,TRANIEN_",",101,"I")'=40
.Q:$$GET1^DIQ(90050.03,TRANIEN_",",2,"I")=""
.;W !,"CREDIT: ",$$GET1^DIQ(90050.03,TRANIEN_",",2,"I")
.;Q:'($$GET1^DIQ(90050.03,TRANIEN_",",101,"I")=40)&($$GET1^DIQ(90050.03,TRANIEN_",",2,"I")'="")
.;
.S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOTPOST","MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOTPOST","MONTHYR",MONTHYR))+$$GET1^DIQ(90050.03,TRANIEN_",",2,"I")
.S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOTPOST",SUB1,SUB2,"MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOTPOST",SUB1,SUB2,"MONTHYR",MONTHYR))+$$GET1^DIQ(90050.03,TRANIEN_",",2,"I")
.S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOT PAY MADE","MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOT PAY MADE","MONTHYR",MONTHYR))+1
.;
.I 'FIRST D Q
..;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOT FIRST PAYMENT MADE","MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOT FIRST PAYMENT MADE","MONTHYR",MONTHYR))+1 ;bar*1.8*28 CR8345 HEAT224215
..S FIRST=$$GET1^DIQ(90050.03,TRANIEN_",",.01,"I")
..S BATCHIEN=$$GET1^DIQ(90050.03,TRANIEN_",",14,"I")
..S BATCHFIN=$$GET1^DIQ(90051.01,BATCHIEN_",",25,"I") ;GET BATCH FINALIZED DATE
..S:BATCHFIN="" BATCHFIN=DT
..S LAST=$$GET1^DIQ(90050.03,TRANIEN_",",.01,"I") ;last pymt wasn't populated if only one bill with one pymt ;bar*1.8*28 CR8345 HEAT224215
..;
..;start old bar*1.8*28 CR8345 HEAT224215
..;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY",SUB1,SUB2,"MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY",SUB1,SUB2,"MONTHYR",MONTHYR))+$$DAYS(BATCHFIN,VSITADMT)
..;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY","MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY","MONTHYR",MONTHYR))+$$DAYS(BATCHFIN,VSITADMT)
..;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY DATES","MONTHYR",MONTHYR,$S(+BATCHFIN:BATCHFIN,1:"UNDEF"),$S(+VSITADMT:VSITADMT,1:"UNDEF"),TRANIEN,$$DAYS(BATCHFIN,VSITADMT))=""
..;end old bar*1.8*28 CR8345 HEAT224215
.;
.;IF YOU ALREADY HAVE FIRST PAYMENT KEEP PLACING FOLLOWING PAYMENTS INTO LAST PAYMENT
.;UNTIL ALL PAYMENTS HAVE BEEN FOUND
.I FIRST D
..;start old bar*1.8*28 CR8345 HEAT224215
..;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY",SUB1,SUB2,"MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY",SUB1,SUB2,"MONTHYR",MONTHYR))+$$DAYS(BATCHFIN,VSITADMT)
..;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY","MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY","MONTHYR",MONTHYR))+$$DAYS(BATCHFIN,VSITADMT)
..;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY DATES","MONTHYR",MONTHYR,$S(+BATCHFIN:BATCHFIN,1:"UNDEF"),$S(+VSITADMT:VSITADMT,1:"UNDEF"),TRANIEN,$$DAYS(BATCHFIN,VSITADMT))=""
..;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOT LAST PAYMENT MADE","MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOT LAST PAYMENT MADE","MONTHYR",MONTHYR))+1
..;end old bar*1.8*28 CR8345 HEAT224215
..S LAST=$$GET1^DIQ(90050.03,TRANIEN_",",.01,"I")
S:$G(FIRST)="" FIRST=DT
S:$G(LAST)="" LAST=DT
Q $G(FIRST)_U_$G(LAST)_U_$G(BATCHFIN)
;
GETPRV(BILLIEN,PRV) ;EP - IS PROV RENDERING/ATTENDING
N PRVREC,FOUND,PRVIEN,TARTYP,PRVTYPE
S (PRVREC,FOUND)=0
S TARGTYP=U_"A"_U_"R"_U ;WE WANT ONLY IF PROVIDER IS FOUND OF TYPE RENDERING OR ATTENDING
S DUZSAVE=DUZ(2) ;bar*1.8*28 CR8345 HEAT224215
S DUZ(2)=ABMDUZ(2) ;bar*1.8*28 CR8345 HEAT224215
F S PRVREC=$O(^ABMDBILL(DUZ(2),BILLIEN,41,PRVREC)) Q:'PRVREC D Q:FOUND
.S PRVTYPE=$$GET1^DIQ(9002274.4041,PRVREC_","_BILLIEN_",",.02,"I")
.S PRVIEN=$$GET1^DIQ(9002274.4041,PRVREC_","_BILLIEN_",",.01,"I")
.I PRV="",(TARGTYP[(U_PRVTYPE_U)) S FOUND=1_U_PRVIEN Q
.I PRV'="" I (TARGTYP[(U_PRVTYPE_U)),(PRVIEN=PRV) S FOUND=1_U_PRVIEN
.;IF NO PROVIDER CHOSEN THEN RETURN TRUE IF ANY ATTENDING/RENDERING PHYSICIAN FOUND INCLUDE BILL
.;IF PROVIDER IS CHOSEN MATCHES PROVIDER TYPE OF ATTENDING OR RENDERING THEN INCLUDE BILL
S DUZ(2)=DUZSAVE ;bar*1.8*28 CR8345 HEAT224215
Q FOUND
;start new bar*1.8*23 IHS/SD/POT
HITCR ;
K DIR S (X,Y)=""
S DIR(0)="E"
S DIR("A")="Hit ENTER to continue"
D ^DIR
K DIR
Q
;end new bar*1.8*23 IHS/SD/POT
;EOR - IHS/DIT/CPC 1.8*28
BARDYSV8 ; IHS/SD/TPF - DAYS IN A/R REPORT CALLS ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**28**;OCT 26,2005;Build 92
+2 ;IHS/SD/POT-1.8*23-FEB 2013 CHANGED PTR TO INSURER TYPE
+3 ;IHS/SD/POT-1.8*23-APR 2013 RESOLVED NIL VALUES OF INSTYP AND ACTINS
+4 ;IHS/SD/SDR-1.8*28-Updated p23 documentation
+5 ;IHS/SD/SDR-1.8*28-Spint from
+6 ;IHS/SD/SDR-1.8*28-CR8345 HEAT224215 - Added code to look thru DUZ(2)s in 3P Bill file for visit IEN. Changed couple FM calls to be straight code.
+7 ; Lookups were failing due to multiple DUZ(2)s. Captured detail in "DET" subscript for detail report. Added code to populate last
+8 ; pymt all the time; was only populated if multiple pymts were made.
+9 QUIT
FIRLSTPY(BILL3P) ;EP - FIND FIRST-LAST PAYMENT MADE IN TRANS FILE
+1 ;N RETURN,TRANIEN,BILLAR,FIRST,LAST ;bar*1.8*28 CR8345 HEAT224215
+2 ;S BILL3P=BILL3P_" ",FIRST=0,LAST=0 ;bar*1.8*28 CR8345 HEAT224215
+3 ;bar*1.8*28 CR8345 HEAT224215
SET BILL3P=BILL3P_" "
+4 ;FIND AR BILL IEN CORRESPONDING TO 3P BILL IEN USING ACTUAL BILL NUMBER
+5 SET BILLAR=$ORDER(^BARBL(DUZ(2),"B",BILL3P))
+6 IF BILLAR=""
QUIT DT_U_DT_U_DT
+7 SET BILLARIE=$ORDER(^BARBL(DUZ(2),"B",BILLAR,""))
+8 SET TRANIEN=""
+9 FOR
SET TRANIEN=$ORDER(^BARTR(DUZ(2),"AC",BILLARIE,TRANIEN))
IF TRANIEN=""
QUIT
Begin DoDot:1
+10 ;NOW FIND FIRST PYMT TRANS
+11 ;IF FIELD #101 'TRANS TYPE' = 'PYMT' AND
+12 ;'CREDIT' FIELD #2 IS NOT NULL THEN GET EARLIEST DATE
+13 IF $$GET1^DIQ(90050.03,TRANIEN_",",101,"I")'=40
QUIT
+14 IF $$GET1^DIQ(90050.03,TRANIEN_",",2,"I")=""
QUIT
+15 ;W !,"CREDIT: ",$$GET1^DIQ(90050.03,TRANIEN_",",2,"I")
+16 ;Q:'($$GET1^DIQ(90050.03,TRANIEN_",",101,"I")=40)&($$GET1^DIQ(90050.03,TRANIEN_",",2,"I")'="")
+17 ;
+18 SET ^XTMP("BARDYSVS",$JOB,"DAYS TO COL VISIT","TOTPOST","MONTHYR",MONTHYR)=$GET(^XTMP("BARDYSVS",$JOB,"DAYS TO COL VISIT","TOTPOST","MONTHYR",MONTHYR))+$$GET1^DIQ(90050.03,TRANIEN_",",2,"I")
+19 SET ^XTMP("BARDYSVS",$JOB,"DAYS TO COL VISIT","TOTPOST",SUB1,SUB2,"MONTHYR",MONTHYR)=$GET(^XTMP("BARDYSVS",$JOB,"DAYS TO COL VISIT","TOTPOST",SUB1,SUB2,"MONTHYR",MONTHYR))+$$GET1^DIQ(90050.03,TRANIEN_",",2,"I")
+20 SET ^XTMP("BARDYSVS",$JOB,"DAYS TO COL VISIT","TOT PAY MADE","MONTHYR",MONTHYR)=$GET(^XTMP("BARDYSVS",$JOB,"DAYS TO COL VISIT","TOT PAY MADE","MONTHYR",MONTHYR))+1
+21 ;
+22 IF 'FIRST
Begin DoDot:2
+23 ;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOT FIRST PAYMENT MADE","MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOT FIRST PAYMENT MADE","MONTHYR",MONTHYR))+1 ;bar*1.8*28 CR8345 HEAT224215
+24 SET FIRST=$$GET1^DIQ(90050.03,TRANIEN_",",.01,"I")
+25 SET BATCHIEN=$$GET1^DIQ(90050.03,TRANIEN_",",14,"I")
+26 ;GET BATCH FINALIZED DATE
SET BATCHFIN=$$GET1^DIQ(90051.01,BATCHIEN_",",25,"I")
+27 IF BATCHFIN=""
SET BATCHFIN=DT
+28 ;last pymt wasn't populated if only one bill with one pymt ;bar*1.8*28 CR8345 HEAT224215
SET LAST=$$GET1^DIQ(90050.03,TRANIEN_",",.01,"I")
+29 ;
+30 ;start old bar*1.8*28 CR8345 HEAT224215
+31 ;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY",SUB1,SUB2,"MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY",SUB1,SUB2,"MONTHYR",MONTHYR))+$$DAYS(BATCHFIN,VSITADMT)
+32 ;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY","MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY","MONTHYR",MONTHYR))+$$DAYS(BATCHFIN,VSITADMT)
+33 ;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY DATES","MONTHYR",MONTHYR,$S(+BATCHFIN:BATCHFIN,1:"UNDEF"),$S(+VSITADMT:VSITADMT,1:"UNDEF"),TRANIEN,$$DAYS(BATCHFIN,VSITADMT))=""
+34 ;end old bar*1.8*28 CR8345 HEAT224215
End DoDot:2
QUIT
+35 ;
+36 ;IF YOU ALREADY HAVE FIRST PAYMENT KEEP PLACING FOLLOWING PAYMENTS INTO LAST PAYMENT
+37 ;UNTIL ALL PAYMENTS HAVE BEEN FOUND
+38 IF FIRST
Begin DoDot:2
+39 ;start old bar*1.8*28 CR8345 HEAT224215
+40 ;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY",SUB1,SUB2,"MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY",SUB1,SUB2,"MONTHYR",MONTHYR))+$$DAYS(BATCHFIN,VSITADMT)
+41 ;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY","MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY","MONTHYR",MONTHYR))+$$DAYS(BATCHFIN,VSITADMT)
+42 ;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","DYSTOPAY DATES","MONTHYR",MONTHYR,$S(+BATCHFIN:BATCHFIN,1:"UNDEF"),$S(+VSITADMT:VSITADMT,1:"UNDEF"),TRANIEN,$$DAYS(BATCHFIN,VSITADMT))=""
+43 ;S ^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOT LAST PAYMENT MADE","MONTHYR",MONTHYR)=$G(^XTMP("BARDYSVS",$J,"DAYS TO COL VISIT","TOT LAST PAYMENT MADE","MONTHYR",MONTHYR))+1
+44 ;end old bar*1.8*28 CR8345 HEAT224215
+45 SET LAST=$$GET1^DIQ(90050.03,TRANIEN_",",.01,"I")
End DoDot:2
End DoDot:1
+46 IF $GET(FIRST)=""
SET FIRST=DT
+47 IF $GET(LAST)=""
SET LAST=DT
+48 QUIT $GET(FIRST)_U_$GET(LAST)_U_$GET(BATCHFIN)
+49 ;
GETPRV(BILLIEN,PRV) ;EP - IS PROV RENDERING/ATTENDING
+1 NEW PRVREC,FOUND,PRVIEN,TARTYP,PRVTYPE
+2 SET (PRVREC,FOUND)=0
+3 ;WE WANT ONLY IF PROVIDER IS FOUND OF TYPE RENDERING OR ATTENDING
SET TARGTYP=U_"A"_U_"R"_U
+4 ;bar*1.8*28 CR8345 HEAT224215
SET DUZSAVE=DUZ(2)
+5 ;bar*1.8*28 CR8345 HEAT224215
SET DUZ(2)=ABMDUZ(2)
+6 FOR
SET PRVREC=$ORDER(^ABMDBILL(DUZ(2),BILLIEN,41,PRVREC))
IF 'PRVREC
QUIT
Begin DoDot:1
+7 SET PRVTYPE=$$GET1^DIQ(9002274.4041,PRVREC_","_BILLIEN_",",.02,"I")
+8 SET PRVIEN=$$GET1^DIQ(9002274.4041,PRVREC_","_BILLIEN_",",.01,"I")
+9 IF PRV=""
IF (TARGTYP[(U_PRVTYPE_U))
SET FOUND=1_U_PRVIEN
QUIT
+10 IF PRV'=""
IF (TARGTYP[(U_PRVTYPE_U))
IF (PRVIEN=PRV)
SET FOUND=1_U_PRVIEN
+11 ;IF NO PROVIDER CHOSEN THEN RETURN TRUE IF ANY ATTENDING/RENDERING PHYSICIAN FOUND INCLUDE BILL
+12 ;IF PROVIDER IS CHOSEN MATCHES PROVIDER TYPE OF ATTENDING OR RENDERING THEN INCLUDE BILL
End DoDot:1
IF FOUND
QUIT
+13 ;bar*1.8*28 CR8345 HEAT224215
SET DUZ(2)=DUZSAVE
+14 QUIT FOUND
+15 ;start new bar*1.8*23 IHS/SD/POT
HITCR ;
+1 KILL DIR
SET (X,Y)=""
+2 SET DIR(0)="E"
+3 SET DIR("A")="Hit ENTER to continue"
+4 DO ^DIR
+5 KILL DIR
+6 QUIT
+7 ;end new bar*1.8*23 IHS/SD/POT
+8 ;EOR - IHS/DIT/CPC 1.8*28
