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

BARDYSV8.m

Go to the documentation of this file. 
  1. BARDYSV8 ; IHS/SD/TPF - DAYS IN A/R REPORT CALLS ; 
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**28**;OCT 26,2005;Build 92
  1.  ;IHS/SD/POT-1.8*23-FEB 2013 CHANGED PTR TO INSURER TYPE
  1.  ;IHS/SD/POT-1.8*23-APR 2013 RESOLVED NIL VALUES OF INSTYP AND ACTINS
  1.  ;IHS/SD/SDR-1.8*28-Updated p23 documentation
  1.  ;IHS/SD/SDR-1.8*28-Spint from
  1.  ;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.
  1.  ;  Lookups were failing due to multiple DUZ(2)s.  Captured detail in "DET" subscript for detail report.  Added code to populate last
  1.  ;  pymt all the time; was only populated if multiple pymts were made.
  1.  Q
  1. FIRLSTPY(BILL3P) ;EP - FIND FIRST-LAST PAYMENT MADE IN TRANS FILE
  1.  ;N RETURN,TRANIEN,BILLAR,FIRST,LAST  ;bar*1.8*28 CR8345 HEAT224215
  1.  ;S BILL3P=BILL3P_" ",FIRST=0,LAST=0  ;bar*1.8*28 CR8345 HEAT224215
  1.  S BILL3P=BILL3P_" "  ;bar*1.8*28 CR8345 HEAT224215
  1.  ;FIND AR BILL IEN CORRESPONDING TO 3P BILL IEN USING ACTUAL BILL NUMBER
  1.  S BILLAR=$O(^BARBL(DUZ(2),"B",BILL3P))
  1.  Q:BILLAR="" DT_U_DT_U_DT
  1.  S BILLARIE=$O(^BARBL(DUZ(2),"B",BILLAR,""))
  1.  S TRANIEN=""
  1.  F  S TRANIEN=$O(^BARTR(DUZ(2),"AC",BILLARIE,TRANIEN)) Q:TRANIEN=""  D
  1.  .;NOW FIND FIRST PYMT TRANS
  1.  .;IF FIELD #101 'TRANS TYPE' = 'PYMT' AND
  1.  .;'CREDIT' FIELD #2 IS NOT NULL THEN GET EARLIEST DATE
  1.  .Q:$$GET1^DIQ(90050.03,TRANIEN_",",101,"I")'=40
  1.  .Q:$$GET1^DIQ(90050.03,TRANIEN_",",2,"I")=""
  1.  .;W !,"CREDIT: ",$$GET1^DIQ(90050.03,TRANIEN_",",2,"I")
  1.  .;Q:'($$GET1^DIQ(90050.03,TRANIEN_",",101,"I")=40)&($$GET1^DIQ(90050.03,TRANIEN_",",2,"I")'="")
  1.  .;
  1.  .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")
  1.  .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")
  1.  .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
  1.  .;
  1.  .I 'FIRST D  Q
  1.  ..;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
  1.  ..S FIRST=$$GET1^DIQ(90050.03,TRANIEN_",",.01,"I")
  1.  ..S BATCHIEN=$$GET1^DIQ(90050.03,TRANIEN_",",14,"I")
  1.  ..S BATCHFIN=$$GET1^DIQ(90051.01,BATCHIEN_",",25,"I")  ;GET BATCH FINALIZED DATE
  1.  ..S:BATCHFIN="" BATCHFIN=DT
  1.  ..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
  1.  ..;
  1.  ..;start old bar*1.8*28 CR8345 HEAT224215
  1.  ..;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)
  1.  ..;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)
  1.  ..;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))=""
  1.  ..;end old bar*1.8*28 CR8345 HEAT224215
  1.  .;
  1.  .;IF YOU ALREADY HAVE FIRST PAYMENT KEEP PLACING FOLLOWING PAYMENTS INTO LAST PAYMENT
  1.  .;UNTIL ALL PAYMENTS HAVE BEEN FOUND
  1.  .I FIRST D
  1.  ..;start old bar*1.8*28 CR8345 HEAT224215
  1.  ..;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)
  1.  ..;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)
  1.  ..;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))=""
  1.  ..;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
  1.  ..;end old bar*1.8*28 CR8345 HEAT224215
  1.  ..S LAST=$$GET1^DIQ(90050.03,TRANIEN_",",.01,"I")
  1.  S:$G(FIRST)="" FIRST=DT
  1.  S:$G(LAST)="" LAST=DT
  1.  Q $G(FIRST)_U_$G(LAST)_U_$G(BATCHFIN)
  1.  ;
  1. GETPRV(BILLIEN,PRV) ;EP - IS PROV RENDERING/ATTENDING
  1.  N PRVREC,FOUND,PRVIEN,TARTYP,PRVTYPE
  1.  S (PRVREC,FOUND)=0
  1.  S TARGTYP=U_"A"_U_"R"_U  ;WE WANT ONLY IF PROVIDER IS FOUND OF TYPE RENDERING OR ATTENDING
  1.  S DUZSAVE=DUZ(2)  ;bar*1.8*28 CR8345 HEAT224215
  1.  S DUZ(2)=ABMDUZ(2)  ;bar*1.8*28 CR8345 HEAT224215
  1.  F  S PRVREC=$O(^ABMDBILL(DUZ(2),BILLIEN,41,PRVREC)) Q:'PRVREC  D  Q:FOUND
  1.  .S PRVTYPE=$$GET1^DIQ(9002274.4041,PRVREC_","_BILLIEN_",",.02,"I")
  1.  .S PRVIEN=$$GET1^DIQ(9002274.4041,PRVREC_","_BILLIEN_",",.01,"I")
  1.  .I PRV="",(TARGTYP[(U_PRVTYPE_U)) S FOUND=1_U_PRVIEN Q
  1.  .I PRV'="" I (TARGTYP[(U_PRVTYPE_U)),(PRVIEN=PRV) S FOUND=1_U_PRVIEN
  1.  .;IF NO PROVIDER CHOSEN THEN RETURN TRUE IF ANY ATTENDING/RENDERING PHYSICIAN FOUND INCLUDE BILL
  1.  .;IF PROVIDER IS CHOSEN MATCHES PROVIDER TYPE OF ATTENDING OR RENDERING THEN INCLUDE BILL
  1.  S DUZ(2)=DUZSAVE  ;bar*1.8*28 CR8345 HEAT224215
  1.  Q FOUND
  1.  ;start new bar*1.8*23 IHS/SD/POT
  1. HITCR ;
  1.  K DIR S (X,Y)=""
  1.  S DIR(0)="E"
  1.  S DIR("A")="Hit ENTER to continue"
  1.  D ^DIR
  1.  K DIR
  1.  Q
  1.  ;end new bar*1.8*23 IHS/SD/POT
  1.  ;EOR - IHS/DIT/CPC 1.8*28