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

BARRUTL.m

Go to the documentation of this file. 
  1. BARRUTL ; IHS/SD/LSL - Report Utility ; 07/26/2010
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,19**;OCT 26, 2005
  1.  ;
  1.  ; IHS/ASDS/LSL - 08/29/00 - Routine created
  1.  ;
  1.  ; IHS/SD/LSL - 04/12/02 - V1.6 Patch 2
  1.  ;     Modified LOOP line tag to allow it to be used for new Age
  1.  ;     Summary Report
  1.  ;
  1.  ; IHS/SD/LSL - 10/03/02 - V1.7 - NDA-0902-180080
  1.  ;      Modified LOOP lne tag to allow reports to sort by date
  1.  ;      correctly.   Reports show ** NO DATA TO PRINT **
  1.  ;
  1.  ; IHS/SD/LSL - 12/06/02 - V1.7 - NHA-0601-180049
  1.  ;      Modified to find bill in 3P correctly.
  1.  ;      
  1.  ; IHS/SD/TMM 1.8*19 7/26/10 Select by Group Plans
  1.  Q
  1.  ; ***************************************************
  1.  ;
  1. LOOP ;EP for Looping thru Bill File
  1.  ; Note:  BARY("OBAL") may not work if other Inclusion Selections made
  1.  ; "OBAL" is OpenBalance bills variable BARY("STCR") is a little tricky IHS/SD/PKD 1/20/11
  1.  I $G(BARY("DT"))]"" D                           ; Sort by Date
  1.  . I BARY("DT")="V" S BARP("X")="E" Q         ; Sort by Visit Date
  1.  . I BARY("DT")="A" S BARP("X")="AG" Q        ; Sort by 3P Approval Date
  1.  . I BARY("DT")="X" S BARP("X")="H" Q         ; Sort by Transmittal Date
  1.  E  I $D(BARY("ACCT")) S BARP("X")="D"        ; Sort by A/R Account
  1.  E  I $D(BARY("PAT")) S BARP("X")="C"         ; Sort by Patient
  1.  E  I $D(BARY("STCR")) S BARP("X")="OBAL"     ; Sort by Open Balance
  1.  E  S BARP("X")=1                             ; Sort by A/R Bill
  1.  I BARP("X") D  Q      ; If no parameters loop entire file
  1.  . S BAR=0
  1.  . F  S BAR=$O(^BARBL(DUZ(2),BAR)) Q:'+BAR  D @("DATA^"_BARP("RTN"))
  1.  I $G(BARY("DT"))]"","AXV"[BARY("DT") D  Q
  1.  . S BARP("DT")=BARY("DT",1)-.5
  1.  . F  S BARP("DT")=$O(^BARBL(DUZ(2),BARP("X"),BARP("DT"))) Q:'BARP("DT")!(BARP("DT")>(BARY("DT",2)+.5))  D
  1.  . . S BAR=""
  1.  . . F  S BAR=$O(^BARBL(DUZ(2),BARP("X"),BARP("DT"),BAR)) Q:'BAR  D @("DATA^"_BARP("RTN"))
  1.  S:$D(BARY("DT")) BARP("DT")=BARY("DT",1)-1
  1.  I $G(BARY("STCR"))]"" D  Q
  1.  . S BAR=0
  1.  . F  S BAR=$O(^BARBL(DUZ(2),BARP("X"),BAR)) Q:'BAR  D @("DATA^"_BARP("RTN"))
  1.  S BAR=""
  1.  S BARP("RI")=$S(BARP("X")="D":BARY("ACCT"),1:BARY("PAT"))
  1.  I $G(BAR("OPT"))="STA" D GRPINS  Q  ; IHS/SD/PKD 1.8*19 move specific code to the end
  1.  F  S BAR=$O(^BARBL(DUZ(2),BARP("X"),BARP("RI"),BAR)) Q:'BAR  D @("DATA^"_BARP("RTN"))
  1.  ;
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. TRANS ;EP for Looping thru Transaction File
  1.  S BARP("X")=$S($G(BARY("DT"))="T":"B",1:1)
  1.  ;S:$D(BARY("BATCH")) BARP("X")="ACB"
  1.  S:$D(BARY("BATCH"))&($G(BARY("DT"))'="T") BARP("X")="ACB"  ;BAR*1.8*6 IHS/SD/TPF 8/12/2008
  1.  I BARP("X") D  Q      ; If no parameters loop entire file
  1.  . S BARTR=0
  1.  . F  S BARTR=$O(^BARTR(DUZ(2),BARTR)) Q:'+BARTR  D @("DATA^"_BARP("RTN"))
  1.  I $G(BARY("DT"))="T" D  Q
  1.  . S BARP("DT")=BARY("DT",1)-.5
  1.  . F  S BARP("DT")=$O(^BARTR(DUZ(2),BARP("X"),BARP("DT"))) Q:'BARP("DT")!(BARP("DT")>(BARY("DT",2)+.5))  D
  1.  . . S BARTR=0
  1.  . . F  S BARTR=$O(^BARTR(DUZ(2),BARP("X"),BARP("DT"),BARTR)) Q:'BARTR  D @("DATA^"_BARP("RTN"))
  1.  I $D(BARY("ITEM")) D  Q
  1.  . S BART=""
  1.  . F  S BART=$O(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARY("ITEM"),BART)) Q:'BART  D
  1.  . . S BARTR=0
  1.  . . F  S BARTR=$O(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARY("ITEM"),BART,BARTR)) Q:'+BARTR  D @("DATA^"_BARP("RTN"))
  1.  E  D  Q
  1.  . S BARI=""
  1.  . F  S BARI=$O(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARI)) Q:'BARI  D
  1.  . . S BART=""
  1.  . . F  S BART=$O(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARI,BART)) Q:'BART  D
  1.  . . . S BARTR=0
  1.  . . . F  S BARTR=$O(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARI,BART,BARTR)) Q:'+BARTR  D @("DATA^"_BARP("RTN"))
  1.  S BARP("RI")=$S(BARP("X")="C":BARY("ACCT"),1:BARY("PAT"))
  1.  S:$D(BARY("DT")) BARP("DT")=BARY("DT",1)-1
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. PSR ; EP - Loop A/R Period Summary Report Data File
  1.  S BAR("L")=0
  1.  F  S BAR("L")=$O(^BARPSR(BAR("L"))) Q:'+BAR("L")  D
  1.  . I $D(BARY("LOC")),BARY("LOC")'=BAR("L") Q   ; Not chosen visit loc
  1.  . S BARPSR=BARBDT-1
  1.  . F  S BARPSR=$O(^BARPSR(BAR("L"),1,BARPSR)) Q:'+BARPSR  D
  1.  . . Q:BARPSR>BAREDT
  1.  . . D @("DATA^"_BARP("RTN")_1)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. PAZ ;EP to pause report
  1.  I '$D(IO("Q")),$E(IOST)="C",'$D(IO("S")) D
  1.  .F  W ! Q:$Y+3>IOSL
  1.  .K DIR
  1.  .S DIR(0)="E"
  1.  .D ^DIR
  1.  .K DIR
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. POUT ;EP for exiting report
  1.  K:$D(BAR("SUBR")) ^TMP(BAR("SUBR"),$J)
  1.  D KILL^%ZTLOAD
  1.  K BARY,BARP,BAR,IO("Q"),POP,DIR,DUOUT,DTOUT,ZTSK,DIROUT,DIRUT,%ZIS
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. MM ;EP
  1.  ; Correct A/R Account and Bill Amount for bills on Mismatch Report
  1.  S DA=0
  1.  F  S DA=$O(^BARBLER(DUZ(2),"AMM",1,DA)) Q:'+DA  D MM2
  1.  K DIE,DA,DR,DIQ,DIC,ABMAMT,ABMINS,ABMINSN,BAR,BAR3PDUZ
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. MM2 ;
  1.  ; Check each entry in A/R bill error for Mismatch
  1.  K DIE,DR,DIC,DIQ,ABMAMT,ABMINS,ABMINSN,BAR,BAR3PDUZ,BAR3PIEN
  1.  S DIC="^BARBL(DUZ(2),"
  1.  S DIQ="BAR("
  1.  S DIQ(0)="IE"
  1.  S DR="3;13;17;22;108"
  1.  D EN^DIQ1
  1.  S BAR("3P LOC")=$$FIND3PB^BARUTL(DUZ(2),DA)
  1.  S BAR3PDUZ=$P(BAR("3P LOC"),",")
  1.  S BAR3PIEN=$P(BAR("3P LOC"),",",2)
  1.  Q:'$G(BAR3PDUZ)
  1.  S BAR3PINS=$P($G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,0)),U,8)
  1.  Q:BAR3PINS=""
  1.  S BAR3PINN=$P($G(^AUTNINS(BAR3PINS,0)),U)
  1.  I BAR3PINN'=$G(BAR(90050.01,DA,3,"E")) D
  1.  . S DR="3///^S X=BAR3PINN"
  1.  . I $P($G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,13,BAR3PINS,0)),U,2)=1 S DR=DR_";205///^S X=BAR3PINN"
  1.  S BAR3PAMT=$P($G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,2)),U)
  1.  I ((BAR3PAMT+.005)\.01/100)'=((BAR(90050.01,DA,13,"I")+.005)\.01/100) S DR=DR_";13///^S X=BAR3PAMT"
  1.  Q:'$D(DR)
  1.  S:$E(DR)=";" DR=$E(DR,2,99)
  1.  S DIE="^BARBL(DUZ(2),"
  1.  D ^DIE
  1.  K DR,DIE,BAR,BAR3PDUZ,BAR3PIEN
  1.  Q
  1.  ;
  1. GRPINS  ;  IHS/SD/TMM 1.8*19 7/20/10
  1.  ; If Group Plan entered, filter 
  1.  F  S BAR=$O(^BARBL(DUZ(2),BARP("X"),BARP("RI"),BAR)) Q:'BAR  D
  1.  . ;If user did not specify a group, report all groups
  1.  . I $G(BAR("OPT"))="STA",'$D(BARY("GRP PLAN")) D @("DATA^"_BARP("RTN")) Q   ;1.8*19 8/16/10
  1.  . ;Verify if group was specified
  1.  . S BARGRPBL=$$GROUPLAN^BARUTL(BAR)   ;Valid grp plan returns: 1^BARGPIEN^BARGPNUM^BARGPNAM...   
  1.  . I $P(BARGRPBL,U)=0!$P(BARGRPBL,U)="" Q     ;Group Plan not found in Employer Group Insurance     
  1.  . S BARGPNUM=$P($P(BARGRPBL,U,2),"|",2)
  1.  . S BARGPIEN=$P($P(BARGRPBL,U,2),"|",1)
  1.  . S BARGPNAM=$P($P(BARGRPBL,U,2),"|",3)
  1.  . I BARGPIEN="" Q
  1.  . I '$D(BARY("GRP PLAN",BARGPIEN)) Q         ;Group Plan for this bill not requested
  1.  . D @("DATA^"_BARP("RTN"))
  1.  ; ;End 1.8*19