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

BARDYSV3.m

Go to the documentation of this file. 
  1. BARDYSV3 ; 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 II modifications
  1.  ; IHS/SD/TMM  01/07/2010  M3  Record XBFLG value returned from ^XBGSAVE
  1.  ; IHS/SD/TMM  01/26/2010  M4  Use 3PB DUZ2 for ^DIQ calls TO 3PB files
  1.  ; IHS/SD/TMM  01/27/2010  M5  Update BATCH routine with current logic (to match INSTALL^BARDYSV4 and INTERACT)
  1.  ; IHS/SD/TMM  01/29/2010  M6  Tag TRANS moved from ^BARDYSV3 to ^BARDYSV5 due to
  1.  ;                             routine size of ^BARDYSV3 and SAC checker requirement
  1.  ; MAR 2012 HEAT# 80021 P.OTTIS (=""1M" changed to ["1M") 
  1.  ; MAR 2012 HEAT# 55217 P.OTTIS Parker - <UNDEFINED>BATCH+36^BARDYSV3
  1.  ; FEB 2013 P.OTT CHANGED PTR TO INSURER TYPE
  1.  Q
  1.  ;
  1.  ;IT IS EXPECTED THAT IF NO DATES ARE PASSED VIA TASKMAN THAT THE TASK WILL BE SCHEDULED
  1.  ;FOR THE FIRST DAY OF THE MONTH AND THE RANGE WILL BE FROM THE 1ST TO THA LAST DAY OF THE
  1.  ;MONTH BEFORE
  1.  ;
  1.  ;ASK DATE RANGE FIND VISITS FOR THAT RANGE IN THE VISIT FILE
  1. INTERACT ;EP - INTERACTIVE EP
  1.  I '$$IHS(DUZ(2)) W !,"THIS REPORT IS NOT INTENDED FOR NON-IHS FACILITIES!!" W ! K DIR S DIR(0)="E" D ^DIR Q
  1.  S ZTQUEUED=$G(ZTQUEUED)
  1.  D INIT
  1.  ;
  1. ASKBEG ;EP - ASK BEGIN DATE
  1.  N BEGDATE,ENDDATE
  1.  K DIR
  1.  S DIR(0)="DO^::EX"
  1.  S DIR("A")="Enter Beginning Visit Date"
  1.  D ^DIR
  1.  Q:$D(DIRUT)!$D(DTOUT)!($D(DUOUT))!(Y="")
  1.  S BEGDATE=Y
  1.  ;
  1. ASKEND ;EP - ASK END DATE
  1.  K DIR
  1.  S DIR(0)="DO^::EX"
  1.  S DIR("A")="Enter Ending Visit Date"
  1.  D ^DIR
  1.  G:$D(DIRUT)!$D(DTOUT)!($D(DUOUT))!(Y="") ASKBEG
  1.  S ENDDATE=Y
  1.  I BEGDATE>ENDDATE W !,"BEGIN DATE CAN NOT BE GREATER THAN ENDING DATE!" K DIR S DIR(0)="E" D ^DIR G ASKEND
  1.  D NOW^%DTC
  1.  S ^BARTMP("BARDYSV3",0,"INTERACT STARTED",DUZ(2),%)=BEGDATE_U_ENDDATE
  1.  W !!
  1.  D VISITS^BARDYSV5(BEGDATE,ENDDATE)
  1.  D BILLS(BEGDATE,ENDDATE)                             ;M2
  1.  ;D TRANS(BEGDATE,ENDDATE)                            ;M2   ;M6*DEL*TMM
  1.  D TRANS^BARDYSV5(BEGDATE,ENDDATE)                    ;M2   ;M6*ADD*TMM
  1.  I '$D(^BAROMB($J)) D  G ASKBEG
  1.  . S BARTMP="NO DATA FOUND FOR OMB REPORT!"
  1.  . W !,BARTMP
  1.  . K DIR
  1.  . S DIR(0)="E"
  1.  . D ^DIR
  1.  . S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETED",DUZ(2),%)=BARTMP
  1.  S RC=$$ASKFNAME^BARDYSV4(.BARFILE,BEGDATE,ENDDATE)
  1.  W !,"DESTINATION FILE: ",BARFILE
  1.  D SENDFILE^BARDYSV4("BAROMB(",BARFILE)               ;M1 BAR*1.8*13 TMM 
  1.  D NOW^%DTC
  1.  S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETED",DUZ(2),%)=""                                                      ;M2
  1.  ; Global copy to flat file successful when XBFLG=0
  1.  ;   XBFLG=0 (zero)    Save was successful. No errors detected
  1.  ;   XBFLG=-1          Save was unsuccessful, If errors detected XBFLG is 
  1.  ;                     set to "-1", error info stored in XBFLG(1) and 
  1.  ;                     XBGSAVE returns to the calling program WITHOUT SAVING THE 
  1.  ;                     FILE.
  1.  ; HEAT# 0055217 P.OTT
  1.  ;
  1.  I $G(XBFLG)'=0 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETED",DUZ(2),%,1)="Global copy of ^BAROMB Failed"_"^"_$G(XBFLG)_"^"_$G(XBFLG(1))   ;M2  ;M3*ADD*TMM
  1.  I $G(XBFLG)=-1 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETED",DUZ(2),%,2)=XBFLG_"^"_$G(XBFLG(1))                                       ;M2  ;M3*ADD*TMM
  1.  I $G(XBFLG)=0 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETE",DUZ(2),%,3)="Global copy ^BAROMB successful"                               ;M2  ;M3*ADD*TMM
  1.  Q
  1.  ;
  1.  ;IT IS EXPECTED THAT IF NO DATES ARE PASSED VIA TASKMAN THAT THE TASK WILL BE SCHEDULED
  1.  ;FOR THE FIRST DAY OF THE MONTH AND THE RANGE WILL BE FROM THE 1ST TO THA LAST DAY OF THE
  1.  ;MONTH BEFORE
  1. BATCH(BARBEG,BAREND) ;EP - ENTER FOR TASKED JOB
  1.  D INIT
  1.  N RANGE,BARBEG,BAREND
  1.  S ^BARTMP("BARDYSV3",0,"JOB")=$J
  1.  I $P(D,U,6)["1M" S RANGE=$$LSTMNTH(DT) S BARBEG=$P(RANGE,U),BAREND=$P(RANGE,U,2) ;P.OTT
  1.  E  I $P(D,U,6)[("D") S %DT="" S X="T-"_+$P(D,U,6) D ^%DT S BARBEG=Y,BAREND=DT
  1.  D NOW^%DTC
  1.  S ^BARTMP("BARDYSV3",0,"BATCH STARTED",%)=BARBEG_U_BAREND
  1.  D VISITS^BARDYSV5(BARBEG,BAREND)
  1.  D BILLS(BARBEG,BAREND)                            ;M2
  1.  ;D TRANS(BARBEG,BAREND)                           ;M2   ;M6*DEL*TMM
  1.  D TRANS^BARDYSV5(BARBEG,BAREND)                   ;M2   ;M6*ADD*TMM
  1.  S ^BARTMP("BARDYSV3",0,"BATCH COMPLETED",DUZ(2),%)="OMB PHASE II - Data Extracted, Ready to send"
  1.  S RC=$$ASKFNAME^BARDYSV4(.BARFILE,BARBEG,BAREND)
  1.  D SENDFILE^BARDYSV4("BAROMB(",BARFILE)               ;M1 BAR*1.8*13 TMM 
  1.  D NOW^%DTC
  1.  ;
  1.  ; HEAT# 0055217 P.OTT
  1.  ;
  1.  I $G(XBFLG)'=0 S ^BARTMP("BARDYSV3",0,"BATCH COMPLETED",DUZ(2),%,1)="Global copy of ^BAROMB Failed"_"^"_$G(XBFLG)_"^"_$G(XBFLG(1))   ;M2  ;M3*ADD*TMM
  1.  I $G(XBFLG)=-1 S ^BARTMP("BARDYSV3",0,"BATCH COMPLETED",DUZ(2),%,2)=$G(XBFLG)_"^"_$G(XBFLG(1))                                   ;M2  ;M3*ADD*TMM
  1.  I $G(XBFLG)=0 S ^BARTMP("BARDYSV3",0,"BATCH COMPLETED",DUZ(2),%,3)="Global copy ^BAROMB successful"                              ;M2  ;M3*ADD*TMM
  1.  ;*** M5*END ADD*TMM ***
  1.  Q
  1.  ;
  1.  ;COMPUTE LAST MONTH'S DAYS IN A MONTH, PASS DT. USE THIS TO GET DATE RANGE
  1. LSTMNTH(TODAY) ;EP - COMPY
  1.  N DAYS,LSTMNTH,FMYR,STARTDAY,ENDDAY
  1.  S FMYR=$E(TODAY,1,3)
  1.  S THISMNTH=$E(TODAY,4,5)
  1.  S LSTMNTH=$E(TODAY,4,5)-1
  1.  I LSTMNTH=0 S LSTMNTH=12
  1.  S X=LSTMNTH
  1.  S X1=X,X=$S("^1^3^5^7^8^10^12^"[(U_X_U):31,X'=2:30,$E(X1,1,3)#4:28,1:29)
  1.  S STARTDAY="01"
  1.  S ENDDAY=X
  1.  S:THISMNTH="01" FMYR=FMYR-1,LSTMNTH=12
  1.  S:$L(LSTMNTH)=1 LSTMNTH="0"_LSTMNTH
  1.  S BEGIN=FMYR_LSTMNTH_STARTDAY
  1.  S END=FMYR_LSTMNTH_ENDDAY
  1.  Q BEGIN_U_END
  1.  ;
  1. IHS(DUZ2) ;EP - RETURN TRUE IF IHS AFFILIATION
  1.  N REC
  1.  S REC=$O(^AUTTLOC(DUZ2,11,""),-1)
  1.  S AFFIL=$$GET1^DIQ(9999999.0611,REC_","_DUZ2_",",.03,"I")
  1.  Q AFFIL=1  ;1 MEANS IHS
  1.  ;
  1. BILLS(BARBEG,BAREND) ;EP - Find 3P Bills for this period
  1.  ;Create sort file for all 3PB's and A/R Bills, then create bill record
  1.  N CNT                                           ;M2
  1.  S BEGIN=BARBEG-.01
  1.  S END=BAREND_".999999"
  1.  ;
  1.  ;Find 3P Bills for this period for all 3PB DUZ(2)
  1.  S TPBDUZ2=0 F  S TPBDUZ2=$O(^ABMDBILL(TPBDUZ2)) Q:'TPBDUZ2  D
  1.  .S TPAPRVDT=BEGIN F CNT=1:1 S TPAPRVDT=$O(^ABMDBILL(TPBDUZ2,"AP",TPAPRVDT)) Q:('TPAPRVDT)!(TPAPRVDT>END)  D     ;3P BILL APPROVE DT/TM
  1.  ..S TPBIEN="" F  S TPBIEN=$O(^ABMDBILL(TPBDUZ2,"AP",TPAPRVDT,TPBIEN)) Q:'TPBIEN  D    ;3P BILL IEN
  1.  ...S ^BARTMP("BARDYSV3",10,"BILLS",TPBIEN,0)=TPAPRVDT_U_U_TPBDUZ2          ;3PB IEN noted
  1.  ;
  1.  ;Now find A/R Bills for this period
  1.  N CNT                                           ;M2
  1.  S TPAPRVDT=BEGIN F CNT=1:1 S TPAPRVDT=$O(^BARBL(DUZ(2),"AG",TPAPRVDT)) Q:('TPAPRVDT)!(TPAPRVDT>END)  D
  1.  .W:'$D(ZTQUEUED)&'(CNT#1000) "."
  1.  .S BARBLIEN=$O(^BARBL(DUZ(2),"AG",TPAPRVDT,"")) Q:'BARBLIEN  D
  1.  ..S TPBIEN=$P($G(^BARBL(DUZ(2),BARBLIEN,0)),U,17)
  1.  ..S:TPBIEN="" TPBIEN=0
  1.  ..;Update ^BARTMP if doesn't exist from the 3P Bill
  1.  ..S ^BARTMP("BARDYSV3",10,"BILLS",TPBIEN,BARBLIEN)=TPAPRVDT
  1.  ..I $D(^BARTMP("BARDYSV3",10,"BILLS",TPBIEN,0)) S $P(^BARTMP("BARDYSV3",10,"BILLS",TPBIEN,0),U,2)="DUP"
  1.  ;
  1.  ;$O thru ^BARTMP and create bill records
  1.  K TMP
  1.  S BILLIEN="" F  S BILLIEN=$O(^BARTMP("BARDYSV3",10,"BILLS",BILLIEN)) Q:BILLIEN=""  D
  1.  .S BARBLIEN="" F  S BARBLIEN=$O(^BARTMP("BARDYSV3",10,"BILLS",BILLIEN,BARBLIEN)) Q:BARBLIEN=""  D
  1.  ..K TMP
  1.  ..I BARBLIEN=0 D
  1.  ...S TMP=$G(^BARTMP("BARDYSV3",10,"BILLS",BILLIEN,BARBLIEN))
  1.  ...S TMP=$P(TMP,U,2)
  1.  ..I $G(TMP)="DUP" Q    ;skip this one, there will be another entry with same 3PBIEN and a real BARBLIEN 
  1.  ..;Get the 3PB IEN DUZ2
  1.  ..S TPBDUZ2=$P($G(^BARBL(DUZ(2),BARBLIEN,0)),"^",22)           ;TPB DUZ(2)
  1.  ..;
  1.  ..;Get multiple visits for 3P Bill   ;M2 20091015
  1.  ..S MULTVIS=""        ;M2 20091015
  1.  ..I TPBDUZ2'="" S VISIT=0 F TMP=1:1 S VISIT=$O(^ABMDBILL(TPBDUZ2,BILLIEN,11,VISIT)) Q:'VISIT  D     ;PCC VISIT IEN  ;M2 20091015
  1.  ...S $P(MULTVIS,"|",TMP)=VISIT            ;send all visits for this 3PB
  1.  ..;M2 20091021 S MULTVIS=$S(MULTVIS["|":MULTVIS,1:"")
  1.  ..;
  1.  ..I TPBDUZ2'="" S VISIT=0 F  S VISIT=$O(^ABMDBILL(TPBDUZ2,BILLIEN,11,VISIT)) Q:'VISIT  D     ;PCC VISIT IEN  ;M2 20091015-moved down here from above
  1.  ...S BARVLOC=$$LOCENC^APCLV(VISIT,"C")  ;API LOC. OF ENCOUNTER ASUFAC  ;M2
  1.  ...S:BARVLOC="" BARVLOC="UNDEF"                                        ;M2
  1.  ...;*** loc testing
  1.  ...;I BARVLOC="UNDEF" D
  1.  ...;look at all scenarios initially
  1.  ...S IENS=BILLIEN
  1.  ...S SAVEDUZ=DUZ(2)                                                   ;M4*ADD*TMM
  1.  ...S DUZ(2)=TPBDUZ2                                                   ;M4*ADD*TMM
  1.  ...S TPBVLOC=$$GET1^DIQ(9002274.4,IENS,.03,"E")      ;VISIT LOCATION  ;M2 20091015
  1.  ...S DUZ(2)=SAVEDUZ                                                   ;M4*ADD*TMM
  1.  ...I TPBVLOC'=BARVLOC D
  1.  ....;S TMPREC=TPBVLOC_U_BARVLOC_U_BILLIEN_U_VISIT                      ;M4*DEL*TMM
  1.  ....;S TMP=$G(^BARTMP("BARDYSV3",1,"VISIT LOC NO MATCH"))+1            ;M4*DEL*TMM
  1.  ....;S ^BARTMP("BARDYSV3",1,"VISIT LOC NO MATCH",TMP,0)=TMPREC    ;M2 20091015  ;M4*DEL*TMM
  1.  ....S TMPREC=TPBVLOC_U_BARVLOC_U_BILLIEN_U_VISIT                      ;M4*ADD*TMM
  1.  ....S TMP=$G(^BARTMP("BARDYSV3",1,"VISIT LOC NO MATCH"))+1            ;M4*ADD*TMM
  1.  ....S ^BARTMP("BARDYSV3",1,"VISIT LOC NO MATCH",TMP,0)=TMPREC   ;M2 20091015   ;M4*ADD*TMM
  1.  ...;*** End loc testing
  1.  ...S IENS=VISIT_","
  1.  ...S BARVDA=VISIT                                                      ;M2
  1.  ...I BARVDA="" S BARVDA=0                                              ;M2
  1.  ...S VISCRDT=$P($$GET1^DIQ(9000010,IENS,.02,"I"),".")  ;DATE VISIT CREATED        ;M2 20091008
  1.  ...S BARMY=($E(VISCRDT,1,3)+1700)_"-"_$E(VISCRDT,4,5)
  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.  ...D BDATA      ;get Bill variables    ;M2
  1.  ...D BREC       ;Write Bill record     ;M2
  1.  Q
  1.  ;
  1. BDATA ;EP - Set 3P Bill data
  1.  S IENS=BILLIEN
  1.  I TPBDUZ2'="" S BILL3P=$P($G(^ABMDBILL(TPBDUZ2,BILLIEN,0)),U)_" "  ;3P BILL NUMBER
  1.  I BILL3P'="" S BILLAR=$O(^BARBL(DUZ(2),"B",BILL3P))                ;A/R BILL NUMBER
  1.  S BLLARIEN=$G(BARBLIEN)
  1.  N D0
  1.  S D0=$$GET1^DIQ(90050.01,BLLARIEN_",",3,"I")                 ;'A/R ACCOUNT' PTR  ;M4*DEL*TMM
  1.  ;S INSTYP=$$GET1^DIQ(9999999.18,INSPTR,.211,"I")  ;RETURNS NUM PTR (I.E. 21) P.OTT GET INS TYP
  1.  S INSTYP=$$VALI^BARVPM(8) ;$P($G(^AUTTINTY(INSTYP,0)),U,2)  ;NUMBER-->"INDIAN PATIENT^I" P.OTT
  1.  I INSTYP="I" S ^BARTMP("BARDYSV3",1,"BILLS SCREENED FOR INSTYP=I")=$G(^BARTMP("BARDYSV3",1,"BILLS SCREENED FOR INSTYP=I"))+1
  1.  ;Use 3PB DUZ2 for 3PB look up
  1.  S SAVEDUZ=DUZ(2)                                  ;M4*ADD*TMM
  1.  S DUZ(2)=TPBDUZ2                                  ;M4*ADD*TMM
  1.  S BILLSTA=$$GET1^DIQ(9002274.4,IENS,.04,"E")                     ;BILL STATUS
  1.  S BILLNUM=$P($$GET1^DIQ(9002274.4,IENS,.01),"-")                 ;3P BILL NUMBER
  1.  S BILLAPP=$$GET1^DIQ(9002274.4,IENS,.15,"I")                     ;3P DATE/TIME APPROVED
  1.  S BILLAMT=$$GET1^DIQ(9002274.4,IENS,.21)                         ;3P BILLED AMOUNT
  1.  S BILLEXP=$$GET1^DIQ(9002274.4,IENS,.17,"I")                     ;3P EXPORT NUMBER (DATE EXPORTED TO A/R)
  1.  S:BILLEXP'="" BILLEXP=$P($G(^ABMDTXST(DUZ(2),BILLEXP,0)),U)      ;INTERNAL FM DATE
  1.  S ACTINS=$$GET1^DIQ(9002274.4,IENS,.08,"E")                      ;ACTIVE INSURER
  1.  S DUZ(2)=SAVEDUZ                                  ;M4*ADD*TMM
  1.  Q
  1.  ;
  1. BREC ;EP - BUILD BILL REC
  1.  I '$D(^BAROMB($J,BARVLOC,BILLIEN,"BILLREC")) D
  1.  .S RECHDR=BARVLOC_U_BILLIEN_U_$S($G(BARMY)'="":BARMY,1:0)
  1.  .S BILLREC=RECHDR_U_BILLIEN
  1.  .S BILLREC=BILLREC_U_BILLNUM
  1.  .S BILLREC=BILLREC_U_BILLAPP
  1.  .S BILLREC=BILLREC_U_BILLAMT
  1.  .S BILLREC=BILLREC_U_BILLEXP
  1.  .S BILLREC=BILLREC_U_ACTINS
  1.  .S BILLREC=BILLREC_U_BILLSTA          ;M2 20090930
  1.  .S BILLREC=BILLREC_U_BARMRG           ;M2 20090930
  1.  .S BILLREC=BILLREC_U_BARVDEL          ;M2 20090930
  1.  .S BILLREC=BILLREC_U_BARDEP           ;M2 20090930
  1.  .S BILLREC=BILLREC_U_MULTVIS          ;M2 20091015
  1.  .S ^BAROMB($J,BARVLOC,BILLIEN,"BILLREC",BARVDA)="B"_U_BILLREC
  1.  .S TMP=$G(^BARTMP("BARDYSV3",$J,"BILLREC"))+1
  1.  .S ^BARTMP("BARDYSV3",$J,"BILLREC")=TMP
  1.  .S ^BARTMP("BARDYSV3",$J,"BILLREC",TMP)="B"_U_BILLREC
  1.  .S ^BARTMP("BARDYSV3",0,20,BARVLOC,"B")=$G(^BARTMP("BARDYSV3",0,20,BARVLOC,"B"))+1
  1.  Q
  1.  ;
  1. INIT ;EP - Initialize
  1.  K ^BAROMB($J)
  1.  ;Kill prior run data
  1.  S TMP=$G(^BARTMP("BARDYSV3",0,"JOB"))
  1.  I TMP'="" K ^BAROMB(TMP)                 ;Kill prior run
  1.  K ^BARTMP("BARDYSV3")
  1.  ;Set for this run
  1.  S ^BARTMP("BARDYSV3",0,"JOB")=$J
  1.  Q  ;EOR