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

BARDUPBL.m

Go to the documentation of this file.
  1. BARDUPBL ; IHS/SD/RLT - Duplicate Bill report modified from BARPT173; [ 05/25/05 ]
  1. ;;1.8;IHS ACCOUNTS RECEIVABLE;**1**;MAR 27,2007
  1. Q
  1. ; *********************************************************************
  1. ;
  1. EN ; EP - Driver
  1. D FINDUP ; Look for duplicate bills
  1. D MAILDUP ; Send dup bill message to manager
  1. Q
  1. ; ********************************************************************
  1. ;
  1. FINDUP ;
  1. ; Find possible AR Bill Multiples (duplicates)
  1. W !!,"Looking for possible duplicate bills..."
  1. K ^BARTMP("DUP")
  1. S BARDUZ=DUZ(2)
  1. S DUZ(2)=0
  1. F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'+DUZ(2) D
  1. . S BARBL=""
  1. . F S BARBL=$O(^BARBL(DUZ(2),"B",BARBL)) Q:BARBL="" D
  1. . . S (BARIEN,BARCNT)=0
  1. . . F S BARIEN=$O(^BARBL(DUZ(2),"B",BARBL,BARIEN)) Q:'+BARIEN D
  1. . . . S BARCNT=BARCNT+1
  1. . . I BARCNT>1 S ^BARTMP("DUP",DUZ(2),BARBL)=BARCNT
  1. S DUZ(2)=BARDUZ
  1. Q
  1. ; *********************************************************************
  1. ;
  1. MAILDUP ;
  1. ; Send a mail message to all holders of the BARZMGR key listing
  1. ; possible duplicates on their system
  1. ;
  1. W !!,"Sending MailMan message to AR Managers..."
  1. D MAILSETM
  1. D MAILTXTM
  1. D MAILMSGM
  1. W " DONE"
  1. Q
  1. ; *********************************************************************
  1. ;
  1. MAILSETM ;
  1. ; Set Mailman Variables
  1. K XMY
  1. S XMSUB="Possible Duplicate A/R Bills"
  1. S XMDUZ="Accounts Receivable Software Engineer"
  1. D MAILISTM ; Get list of recipients
  1. Q
  1. ; *********************************************************************
  1. ;
  1. MAILISTM ;
  1. ; Find users who hold the BARZ MANAGER key
  1. ;S XMY("STAR,GLEN R")=""
  1. S J=0
  1. F S J=$O(^XUSEC("BARZ MANAGER",J)) Q:'+J D
  1. . S BARNAME=$P($G(^VA(200,J,0)),U)
  1. . S XMY(BARNAME)=""
  1. Q
  1. ; *********************************************************************
  1. ;
  1. MAILTXTM ;
  1. ; Determine body of e-mail
  1. K ^BARTMP("173MSG")
  1. S K=0
  1. F D Q:BARTXT="END"
  1. . S K=K+1
  1. . S BARTXT=$P($T(@2+K),";;",2)
  1. . I BARTXT="END" Q
  1. . S ^BARTMP("173MSG",K)=BARTXT
  1. ;
  1. ; Now get the duplicated bills
  1. ;
  1. I '$D(^BARTMP("DUP")) D Q
  1. . S ^BARTMP("173MSG",K+1)="***** NO DUPLICATE BILLS FOUND ****"
  1. ;
  1. S $P(BARDASH,"-",51)=""
  1. S $P(BAREQUAL,"=",51)=""
  1. S BARCNT=0
  1. S BARTOT=0
  1. S BARPAR=0
  1. F S BARPAR=$O(^BARTMP("DUP",BARPAR)) Q:'+BARPAR D
  1. . S (BARFCNT,BARFBT)=0
  1. . S K=K+1
  1. . S ^BARTMP("173MSG",K)="Parent Facility: "_$$GET1^DIQ(4,BARPAR,.01)
  1. . S K=K+1
  1. . S ^BARTMP("173MSG",K)=" "
  1. . S BARBL=""
  1. . F S BARBL=$O(^BARTMP("DUP",BARPAR,BARBL)) Q:BARBL="" D
  1. . . S BARFCNT=BARFCNT+1
  1. . . S BARCNT=BARCNT+1
  1. . . S BARBIL=$E(BARBL,1,20)
  1. . . F I=$L(BARBIL):1:25 S BARBIL=BARBIL_" "
  1. . . S BARIEN=0
  1. . . F S BARIEN=$O(^BARBL(BARPAR,"B",BARBL,BARIEN)) Q:'+BARIEN D
  1. . . . Q:'$D(^BARBL(BARPAR,BARIEN))
  1. . . . S BARIENO="'"_BARIEN
  1. . . . F I=$L(BARIENO):1:10 S BARIENO=BARIENO_" "
  1. . . . S BARPIEN=$P($G(^BARBL(BARPAR,BARIEN,1)),U)
  1. . . . S:BARPIEN]"" BARPAT=$E($$GET1^DIQ(9000001,BARPIEN,.01),1,20)
  1. . . . S:BARPIEN="" BARPAT=""
  1. . . . F I=$L(BARPAT):1:25 S BARPAT=BARPAT_" "
  1. . . . ;S BARBAMT=$P($G(^BARBL(BARPAR,BARIEN,0)),U,13) ;don't use bill amt
  1. . . . S BARBAMT=$P($G(^BARBL(BARPAR,BARIEN,0)),U,15) ;use current amt
  1. . . . S BARBAMTO=$J($FN(BARBAMT,",",2),15)
  1. . . . S K=K+1
  1. . . . S ^BARTMP("173MSG",K)=BARIENO_BARBIL_BARPAT_BARBAMTO
  1. . . S BARFBT=BARBAMT+BARFBT ; Facility bill total
  1. . . S BARTOT=BARBAMT+BARTOT
  1. . S K=K+1
  1. . S ^BARTMP("173MSG",K)=$J(BARDASH,79)
  1. . S K=K+1
  1. . S ^BARTMP("173MSG",K)=$J("Unique bill count: ",58)_$J(BARFCNT,4)_$J($FN(BARFBT,",",2),16)
  1. . S K=K+1
  1. . S ^BARTMP("173MSG",K)=" "
  1. S ^BARTMP("173MSG",K)=$J(BAREQUAL,79)
  1. S K=K+1
  1. S ^BARTMP("173MSG",K)=$J("Total unique bill count: ",58)_$J(BARCNT,4)_$J($FN(BARTOT,",",2),16)
  1. Q
  1. ; *********************************************************************
  1. ;
  1. MAILMSGM ;
  1. S XMTEXT="^BARTMP(""173MSG"","
  1. S %H=$H
  1. D YX^%DTC
  1. N DIFROM
  1. D ^XMD
  1. Q
  1. ; *********************************************************************
  1. ;
  1. 2 ;;
  1. ;;The following is a list of possible duplicate A/R Bills found on your
  1. ;;system.
  1. ;;
  1. ;; IEN Bill Patient Current Amount
  1. ;;
  1. ;;END