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

BARPBEN.m

Go to the documentation of this file. 
  1. BARPBEN ; IHS/SD/LSL - AUTO POSTING OF BENEFICIARY ACCOUNTS ; 
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**21,23**;OCT 26, 2005
  1.  ;;
  1.  ; IHS/SD/LSL - 04/29/03 - V1.8
  1.  ;     Tweaked code for national release.  Original routine AZLKAP01.
  1.  ;     Thanks to California area (7/10/2000)
  1.  ;
  1.  ;APR 2012 P.OTTIS TICKET # 66991 CODE FIX: <UNDEF> LOOP+21
  1.  ;                        # 64722
  1.  ;                        # 57240
  1.  ; ********************************************************************
  1.  Q
  1.  ;
  1. EN ; EP
  1.  ; SELECT ACCOUNT
  1.  Q:$G(XQUIT)=1  ;IHS/SD/TPF BAR*1.8*21 HEAT43451
  1.  D:'$D(BARUSR) INIT^BARUTL                     ; Setup basic AR var
  1.  S BAR("PRIVACY")=1                            ; Privacy Act applies
  1.  S BAR("LOC")="BILLING"                        ;Always Billing location
  1.  I $D(^XTMP("BAR-BEN")) D  Q
  1.  . W !!!,"***AUTO POSTING JOB IN PROGRESS ***"
  1.  . D EOP^BARUTL(0)
  1.  D ASK                                         ; Ask user prompts
  1.  Q:'+BARACDA!('$D(BARSBY))
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
  1.  S BARQ("RC")="LOOP^BARPBEN"
  1.  S BARQ("RP")="PRINT^BARPBEN2"
  1.  S BARQ("RX")="POUT^BARRUTL"
  1.  S BARQ("NS")="BAR"
  1.  D ^BARDBQUE
  1.  D PAZ^BARRUTL
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. ASK ;
  1.  ; Ask AR Account to Auto Post
  1.  W !!
  1.  S BARACDA=0
  1.  K DIC,DA
  1.  S DIC="^BARAC(DUZ(2),"
  1.  S DIC("A")="Select Beneficiary Account to be Auto-Posted: "
  1.  S DIC("S")="N ZZ S ZZ=$$GET1^DIQ(90050.02,+Y,.01) I ZZ[""BENEFIC"",ZZ[""PATIENT"",ZZ'[""NON"""
  1.  S DIC(0)="AEQZ"
  1.  D ^DIC
  1.  Q:Y'>0
  1.  S BARACDA=+Y
  1.  S BARACNM=Y(0,0)
  1.  ;
  1.  ; Is this the Account they really want to Auto post
  1.  W !!,"Account selected is ",BARACNM,!
  1.  K DIR
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Is this the proper account"
  1.  D ^DIR
  1.  K DIR
  1.  Q:Y'>0
  1.  ;
  1.  ; Are they sure they want to Auto Post said account
  1.  W !!,"Proceeding with Auto-Posting of: ",BARACNM,!!
  1.  K DIR
  1.  S DIR(0)="SOB^P:Patient;B:Bill"
  1.  S DIR("A")="Select Report Sorting By:(Patient/Bill)  "
  1.  S DIR("B")="B"
  1.  D ^DIR
  1.  K DIR,DIC
  1.  I "BP"'[Y Q
  1.  S BARSBY=Y
  1.  Q
  1.  ; ********************************************************************
  1.  ; ********************************************************************
  1.  ;
  1. LOOP ; EP
  1.  ; Loop ABAL index
  1.  S BARCNT=0,BARTOT=0
  1.  D BASIC
  1.  S BARDR=DR
  1.  ;
  1.  S ^XTMP("BAR-BEN",$J,0)=DT_U_DT_U_"AUTO POSTING OF BENEFICIARY BILLS LOG"
  1.  S BARBLDA=0
  1.  F  S BARBLDA=$O(^BARBL(DUZ(2),"ABAL",BARACDA,BARBLDA)) Q:'+BARBLDA  D
  1.  . D GET
  1.  . S HAVETRIEN=0 ;P.OTTIS TICKET # 66991
  1.  . D POST
  1.  . I HAVETRIEN=0 QUIT  ;P.OTTIS TICKET # 66991
  1.  . Q:BARTRIEN<1
  1.  . D LOG
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. BASIC ;EP ASSEMBLE BASIC DATA FOR TRANSACTION   
  1.  ;
  1.  S DR="2////^ S X=BARBIL(15)"                  ; Credit
  1.  S DR=DR_";4////^S X=BARBLDA"                  ; A/R Bill
  1.  S DR=DR_";5////^S X=BARBIL(101,""I"")"        ; A/R Patient
  1.  S DR=DR_";6////^S X=BARBIL(3,""I"")"          ; A/R Account
  1.  S DR=DR_";8////^S X=DUZ(2)"                   ; Parent Location
  1.  S DR=DR_";9////^S X=DUZ(2)"                   ; Parent ASUFAC
  1.  S DR=DR_";10////^S X=BARBIL(10,""I"")"        ; A/R Section
  1.  S DR=DR_";11////^S X=BARBIL(108,""I"")"       ; Visit Location
  1.  S DR=DR_";12////^S X=DT"                      ; Date
  1.  S DR=DR_";13////^S X=DUZ"                     ; Entry by
  1.  S DR=DR_";101////^S X=43"                     ; Transaction Type
  1.  S DR=DR_";102////3"                           ; Adjust Cat Write Off
  1.  S DR=DR_";103////136"                         ; Adjust type Indian Ben
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. GET ;EP pull data for posting
  1.  K BARBL
  1.  D ENP^XBDIQ1(90050.01,BARBLDA,".001;.01;3;10;13;15;18;101;102;108","BARBIL(","EI")
  1.  I $E(IOST)="C" W "."
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. POST ;EP
  1.  ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
  1.  I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q  ;IS SESSION STILL OPEN
  1.  ; SET TRANSACTION & POST FILES
  1.  S BARTRIEN=$$NEW^BARTR               ; Create Transaction
  1.  ; Populate Transaction file
  1.  I BARTRIEN<1 D MSG^BARTR(BARBLDA) Q
  1.  S HAVETRIEN=1                        ;P.OTTIS TICKET # 66991
  1.  S DA=BARTRIEN                        ; IEN to A/R TRANSACTION
  1.  S DIE=90050.03
  1.  S DIDEL=90050
  1.  S DR=BARDR
  1.  D ^DIE
  1.  K DIDEL,DIE,DA,DR
  1.  ; Post from transaction file to related files
  1.  D TR^BARTDO(BARTRIEN)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. LOG ;EP
  1.  ; log entry into ^XTMP
  1.  I BARSBY="P" S ^XTMP("BAR-BEN",$J,BARBIL(101),BARBIL(.01))=BARBIL(15)_U_BARBIL(102)
  1.  I BARSBY="B" S ^XTMP("BAR-BEN",$J,BARBIL(.01))=BARBIL(15)_U_BARBIL(102)_U_BARBIL(101)
  1.  S BARTOT=BARTOT+BARBIL(15)
  1.  S BARCNT=BARCNT+1
  1.  Q