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

BARUFEXU.m

Go to the documentation of this file. 
  1. BARUFEXU ; IHS/SD/TPF - UTILITY EXTRACT RTN FOR UFMS ;03/26/08
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**4**;NOV 19, 2007
  1.  ;  NEW ROUTINE-- IHS/IOT/MRS:BAR*1.8*4 UFMS
  1.  ; This routine checks for certain missing or invalid data in the
  1.  ; A/R BILL IHS file
  1.  ; If an error is found, the routine attempts to correct the problem.
  1.  ; If not it sets the "NOT SENT" flag in the A/R UFMS CASHIER SESSION LOG
  1.  ; file, and sets the REASON NOT SENT field and quits, returning a null value.
  1.  Q
  1.  ;
  1. GETDUZ2(BARBLN,UDUZ,SESSID,TRDATE,ARBILL) ;EP; EXTRINSIC FUNCTION TO FIND TPB DUZ(2)
  1.  ;
  1.  ; This sub-routine returns the Third Party Billing DUZ(2) from the
  1.  ; A/R BILL IHS file **or** if it is missing, searches the 3P BILL file and
  1.  ; checks for errors. The routine loops through the TPB BILL file primary
  1.  ; node (DUZ(2)) and looks for a match with the TPB IEN stored in A/R BILL file
  1.  ;
  1.  ; If there is no match, or the TPB IEN, Patient, or Payer info is
  1.  ; missing, an error is created and the process quits.
  1.  ;
  1.  ; If it finds an entry, the routine checks for further matches.
  1.  ;
  1.  ; If the Bill Number, Patient, or Payer pointers do not match, an
  1.  ; error is created and the process quits.
  1.  ;
  1.  ; If there are no errors, the routine modifies the A/R BILL IHS file
  1.  ; and returns the TPB IEN to the calling routine.
  1.  ;
  1.  ;     ENTERS WITH:  BARBLN = AR BILL IEN
  1.  ;                     UDUZ = AR USER PTR
  1.  ;                   SESSID = SESSION ID
  1.  ;                   TRDATE = TRANSMISSION DATE
  1.  ;                   ARBILL = A/R BILL NUMBER
  1.  ;     RETURNS: THIRD PARTY DUZ(2) or null and ERROR message
  1.  ;
  1.  ;If an error is found, the routine sets the "NOT SENT" flag in the
  1.  ;A/R UFMS CASHIER SESSION LOG file, and sets the REASON NOT SENT field and quits
  1.  ;returning a null value.
  1.  ;
  1.  S TPBDUZ2=$P($G(^BARBL(DUZ(2),BARBLN,0)),U,22)   ;A/R BILL, 3P DUZ(2)
  1.  I TPBDUZ2]"" Q TPBDUZ2                           ;Has value
  1.  ;
  1.  N BARPAT,BARPAY,MSG
  1.  S IENS=TRDATE_","
  1.  S MSG=""
  1.  S BARPAT=$P($G(^BARBL(DUZ(2),BARBLN,1)),U)
  1. ERR10 I BARPAT="" D ERR(10) Q ""                       ;No patient
  1.  S BARBACC=$$GETBACC(BARBLN)
  1.  I 'BARBACC Q ""                           ;A/R BILL, A/R ACCOUNT PTR
  1.  S BARPAY=+$$IEN^BARVPM                    ;INSURER PTR
  1. ERR11 I 'BARPAY D ERR(11) Q ""                  ;No insurer
  1.  S ABMIEN=$$GETTPB(BARBLN)                 ;A/R BILL, 3P IEN (DA)
  1.  I ABMIEN="" Q ""                          ;ERROR AND QUIT
  1.  ;
  1.  N ABMDUZ,ABMTMP
  1.  S ABMDUZ=0
  1.  F  S ABMDUZ=$O(^ABMDBILL(ABMDUZ)) Q:'ABMDUZ  D  Q:TPBDUZ2]""
  1.  .Q:'$D(^ABMDBILL(ABMDUZ,ABMIEN))            ;NOT IN THIS DUZ(2)
  1.  .S ABMTMP=$G(^ABMDBILL(ABMDUZ,ABMIEN,0))
  1. ERR13 .I $G(ABMTMP)="" D ERR(13) Q           ;TPB missing
  1.  .S ABMBIL=$P(ABMTMP,U)                 ;TPB BILL NUMBER
  1.  .S ABMPAT=$P(ABMTMP,U,5)               ;TPB PATIEN IEN
  1.  .S ABMPAY=$P(ABMTMP,U,8)               ;TPB INSURER IEN
  1. ERR14 .I ABMBIL'=$P(ARBILL,"-",1) D ERR(14) Q  ;Bill numbers don't match
  1. ERR15 .I ABMPAT'=BARPAT D ERR(15) Q          ;Patient pointers don't match
  1. ERR16 .I ABMPAY'=BARPAY D ERR(16) Q          ;Insurers don't match
  1.  .;HAVE A MATCH -- NOW STUFF DUZ(2) INTO AR BILL FILE
  1.  .K DR
  1.  .S DIE="^BARBL(DUZ(2),"
  1.  .S DA=BARBLN
  1.  .S DR="22////"_ABMDUZ                   ;SET TPB DUZ(2)
  1.  .D ^DIE
  1.  .S TPBDUZ2=ABMDUZ
  1. ERR17 I 'TPBDUZ2 D ERR(17)                    ;Can't find TPB DUZ(2)
  1.  Q TPBDUZ2
  1.  ;
  1. GETBACC(BARBLN) ;EP;
  1.  ;     ENTERS WITH:  BARBLN = AR BILL IEN
  1.  ;
  1.  ;     RETURNS: A/R ACCOUNT or null and ERROR message
  1.  ;
  1.  S D0=$P($G(^BARBL(DUZ(2),BARBLN,0)),U,3)     ;A/R BILL, A/R ACCOUNT PTR
  1. ERR12 I 'D0 D ERR(12) Q ""                         ;Pointer is missing
  1.  Q D0
  1.  ;
  1. GETPLOC(BARBLN) ;EP;Check Parent Location
  1.  ;     ENTERS WITH:  BARBLN = AR BILL IEN
  1.  ;
  1.  ;     RETURNS: PARENT LOCATION or null and ERROR message
  1.  ;
  1.  N BARPLOC,BARVLOC
  1.  S BARPLOC=$P($G(^BARBL(DUZ(2),BARBLN,0)),U,8)  ;A/R BILL, PARENT LOCATION
  1.  I BARPLOC Q BARPLOC
  1.  I 'BARPLOC D                                   ;Not found/or bad location
  1.  .S BARVLOC=$P($G(^BARBL(DUZ(2),BARBLN,1)),U,8) ;A/R BILL, VISIT LOCATION
  1.  .S BARPLOC=$$PARENT                                ;A/R PARENT/SATELITE
  1. ERR18 I 'BARPLOC D ERR(18) Q ""                      ;Can't find parent
  1.  ;Have a match -- now stuff DUZ(2) into AR BILL/IHS file
  1.  ;  also updates the ASUFAC-IEN and A/R BILLING SITE/ASUFAC fields 
  1.  K DR
  1.  S DIE="^BARBL(DUZ(2),"
  1.  S DA=BARBLN
  1.  S DR="8////"_BARPLOC                               ;Set Parent Location
  1.  D ^DIE
  1.  Q BARPLOC
  1.  ;
  1. GETASUFA(BARBLN) ;EP;Check ASUFAC; if not in document, find and populate or error
  1.  ;
  1.  ;     ENTERS WITH:  BARBLN = AR BILL IEN
  1.  ;
  1.  ;     RETURNS: ASUFAC or null and ERROR message
  1.  ;
  1.  N BARASUF
  1.  S BARASUF=$P($P($G(^BARBL(DUZ(2),BARBLN,0)),U,9),"-")
  1.  I 'BARASUF D
  1.  .S BARASUF=$$GETSUFAC^BARUFUT1
  1.  .I BARASUF D
  1.  ..K DR
  1.  ..S DIE="^BARBL(DUZ(2),"
  1.  ..S DA=BARBLN
  1.  ..S DR=".02////"_BARASUF_"-"_BARBLN          ;Set ASUFAC - IEN
  1.  ..D ^DIE
  1. ERR19 I 'BARASUF D ERR(19)                         ;Can't build asufac
  1.  Q BARASUF
  1.  ;
  1. ERR(BARREAS) ;EP; Message Center and Error Processor
  1.  ;ALWAYS WRITE MESSAGE
  1.  W !!,"TRANSACTION "_TRDATE_" HAS NOT BEEN SENT BECAUSE"
  1.  I BARREAS="I" D  Q
  1.  .W !,"IS ONE OF A PAIR OF IGNORED TRANSACTIONS IN "_ARBILL
  1.  W !,$P($G(^BARUFERR(BARREAS,0)),U,5)
  1.  W !," FOR A/R BILL "_ARBILL
  1.  N DIR,DIE,DIC,DA,DR
  1.  S DA(2)=UDUZ
  1.  S DA(1)=SESSID
  1.  S DA=TRDATE
  1.  S DIE="^BARSESS(DUZ(2),"_UDUZ_",11,"_SESSID_",2,"
  1.  S DR=".06////^S X=1;.09///"_$G(BARREAS)
  1.  D ^DIE
  1.  Q
  1.  ;
  1. PARENT() ;EP:   get parent from parent/satellite file
  1.  ;
  1.  N BARSAT,BARPAR,DA,ASUFAC
  1.  S BARSAT=DUZ(2)
  1.  S BARPAR=0                               ; Parent
  1.  ; check site active at DOS to ensure bill added to correct site
  1.  S DA=0
  1.  F  S DA=$O(^BAR(90052.06,DA)) Q:DA'>0  D  Q:BARPAR
  1.  . Q:'$D(^BAR(90052.06,DA,DA))      ; Pos Parent UNDEF Site Parameter
  1.  . Q:'$D(^BAR(90052.05,DA,BARSAT))  ; Satellite UNDEF Parent/Satellit
  1.  . Q:+$P($G(^BAR(90052.05,DA,BARSAT,0)),U,5)  ; Par/Sat not usable
  1.  . ; Q if sat NOT active at DT
  1.  . I DT<$P($G(^BAR(90052.05,DA,BARSAT,0)),U,6) Q
  1.  . ; Q if sat became NOT active before DT
  1.  . I $P($G(^BAR(90052.05,DA,BARSAT,0)),U,7),(DT>$P($G(^BAR(90052.05,DA,BARSAT,0)),U,7)) Q
  1.  . S BARPAR=$S(BARSAT:$P($G(^BAR(90052.05,DA,BARSAT,0)),U,3),1:"")
  1.  Q BARPAR
  1.  ;
  1. GETTPB(BARBLN) ;EP;
  1.  ;
  1.  ;     ENTERS WITH:  BARBLN = AR BILL IEN
  1.  ;
  1.  ;     RETURNS: THIRD PARTY IEN or null and ERROR message
  1.  ;
  1.  N ABMIEN
  1.  S ABMIEN=$P($G(^BARBL(DUZ(2),BARBLN,0)),U,17)  ;A/R BILL, 3P IEN (DA)
  1. ERR20 I ABMIEN="" D ERR(20) Q ""      ;No pointer, create error and quit
  1.  Q ABMIEN
  1.  ;
  1. GETTRDT(TPBDUZ2,TPBIEN) ;EP; GET 3P TRANSMISSION DATE
  1.  ;
  1.  ;Check if the 3P Bill (Invoice) has been sent to A/R from 3P
  1.  ;If so, the Invoice # will be returned as ASUFACASUFACIEN
  1.  ;
  1.  N TPBAPDT,TPBEXDT
  1.  S UFMSSUFC=""
  1.  S TPBAPDT=$$APPRDTTM^ABMUEAPI(TPBDUZ2,TPBIEN)  ;API 3P APPROVAL DATE
  1.  I TPBAPDT="" D  Q UFMSSUFC
  1. ERR21 .D ERR(21)                                     ;3PB not approved
  1.  ;
  1.  ;Prelive logic for 'APPLY TO' or ASUFACASUFAC3PIEN string
  1.  ;If Date/Time Approved < 10/1/2007 then UFMSSUFC=$$PRELIVE instead
  1.  ;
  1.  ;If this is true there will be no delay send at all
  1.  ;
  1.  S BAR08DT=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),15)),U,5)  ;IHS/SD/SDR bar*1.8*4 SCR100
  1.  I TPBAPDT<PRELIVLM!(TPBAPDT<BAR08DT) D  Q UFMSSUFC  ;IHS/SD/SDR bar*1.8*4 SCR100
  1.  .S PRELIV=$$PRELIVE^BARUFUT1(BARAREA,BARITYP)
  1.  .S UFMSSUFC=PRELIV
  1.  ;
  1.  I $L($T(TRANSMIT^ABMUEAPI)) D
  1.  .S UFMSSUFC=$$TRANSMIT^ABMUEAPI(TPBDUZ2,TPBIEN)
  1.  I 'UFMSSUFC D  Q UFMSSUFC
  1. ERR22 .D ERR(22)                                  ;3PB bill not sent to UFMS
  1.  .S UFMSSUFC=""          ;Sometimes UFMSSUFC can be -1
  1.  Q UFMSSUFC