BARDUPBL ; IHS/SD/RLT - Duplicate Bill report modified from BARPT173; [ 05/25/05 ]
;;1.8;IHS ACCOUNTS RECEIVABLE;**1**;MAR 27,2007
Q
; *********************************************************************
;
EN ; EP - Driver
D FINDUP ; Look for duplicate bills
D MAILDUP ; Send dup bill message to manager
Q
; ********************************************************************
;
FINDUP ;
; Find possible AR Bill Multiples (duplicates)
W !!,"Looking for possible duplicate bills..."
K ^BARTMP("DUP")
S BARDUZ=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'+DUZ(2) D
. S BARBL=""
. F S BARBL=$O(^BARBL(DUZ(2),"B",BARBL)) Q:BARBL="" D
. . S (BARIEN,BARCNT)=0
. . F S BARIEN=$O(^BARBL(DUZ(2),"B",BARBL,BARIEN)) Q:'+BARIEN D
. . . S BARCNT=BARCNT+1
. . I BARCNT>1 S ^BARTMP("DUP",DUZ(2),BARBL)=BARCNT
S DUZ(2)=BARDUZ
Q
; *********************************************************************
;
MAILDUP ;
; Send a mail message to all holders of the BARZMGR key listing
; possible duplicates on their system
;
W !!,"Sending MailMan message to AR Managers..."
D MAILSETM
D MAILTXTM
D MAILMSGM
W " DONE"
Q
; *********************************************************************
;
MAILSETM ;
; Set Mailman Variables
K XMY
S XMSUB="Possible Duplicate A/R Bills"
S XMDUZ="Accounts Receivable Software Engineer"
D MAILISTM ; Get list of recipients
Q
; *********************************************************************
;
MAILISTM ;
; Find users who hold the BARZ MANAGER key
;S XMY("STAR,GLEN R")=""
S J=0
F S J=$O(^XUSEC("BARZ MANAGER",J)) Q:'+J D
. S BARNAME=$P($G(^VA(200,J,0)),U)
. S XMY(BARNAME)=""
Q
; *********************************************************************
;
MAILTXTM ;
; Determine body of e-mail
K ^BARTMP("173MSG")
S K=0
F D Q:BARTXT="END"
. S K=K+1
. S BARTXT=$P($T(@2+K),";;",2)
. I BARTXT="END" Q
. S ^BARTMP("173MSG",K)=BARTXT
;
; Now get the duplicated bills
;
I '$D(^BARTMP("DUP")) D Q
. S ^BARTMP("173MSG",K+1)="***** NO DUPLICATE BILLS FOUND ****"
;
S $P(BARDASH,"-",51)=""
S $P(BAREQUAL,"=",51)=""
S BARCNT=0
S BARTOT=0
S BARPAR=0
F S BARPAR=$O(^BARTMP("DUP",BARPAR)) Q:'+BARPAR D
. S (BARFCNT,BARFBT)=0
. S K=K+1
. S ^BARTMP("173MSG",K)="Parent Facility: "_$$GET1^DIQ(4,BARPAR,.01)
. S K=K+1
. S ^BARTMP("173MSG",K)=" "
. S BARBL=""
. F S BARBL=$O(^BARTMP("DUP",BARPAR,BARBL)) Q:BARBL="" D
. . S BARFCNT=BARFCNT+1
. . S BARCNT=BARCNT+1
. . S BARBIL=$E(BARBL,1,20)
. . F I=$L(BARBIL):1:25 S BARBIL=BARBIL_" "
. . S BARIEN=0
. . F S BARIEN=$O(^BARBL(BARPAR,"B",BARBL,BARIEN)) Q:'+BARIEN D
. . . Q:'$D(^BARBL(BARPAR,BARIEN))
. . . S BARIENO="'"_BARIEN
. . . F I=$L(BARIENO):1:10 S BARIENO=BARIENO_" "
. . . S BARPIEN=$P($G(^BARBL(BARPAR,BARIEN,1)),U)
. . . S:BARPIEN]"" BARPAT=$E($$GET1^DIQ(9000001,BARPIEN,.01),1,20)
. . . S:BARPIEN="" BARPAT=""
. . . F I=$L(BARPAT):1:25 S BARPAT=BARPAT_" "
. . . ;S BARBAMT=$P($G(^BARBL(BARPAR,BARIEN,0)),U,13) ;don't use bill amt
. . . S BARBAMT=$P($G(^BARBL(BARPAR,BARIEN,0)),U,15) ;use current amt
. . . S BARBAMTO=$J($FN(BARBAMT,",",2),15)
. . . S K=K+1
. . . S ^BARTMP("173MSG",K)=BARIENO_BARBIL_BARPAT_BARBAMTO
. . S BARFBT=BARBAMT+BARFBT ; Facility bill total
. . S BARTOT=BARBAMT+BARTOT
. S K=K+1
. S ^BARTMP("173MSG",K)=$J(BARDASH,79)
. S K=K+1
. S ^BARTMP("173MSG",K)=$J("Unique bill count: ",58)_$J(BARFCNT,4)_$J($FN(BARFBT,",",2),16)
. S K=K+1
. S ^BARTMP("173MSG",K)=" "
S ^BARTMP("173MSG",K)=$J(BAREQUAL,79)
S K=K+1
S ^BARTMP("173MSG",K)=$J("Total unique bill count: ",58)_$J(BARCNT,4)_$J($FN(BARTOT,",",2),16)
Q
; *********************************************************************
;
MAILMSGM ;
S XMTEXT="^BARTMP(""173MSG"","
S %H=$H
D YX^%DTC
N DIFROM
D ^XMD
Q
; *********************************************************************
;
2 ;;
;;The following is a list of possible duplicate A/R Bills found on your
;;system.
;;
;; IEN Bill Patient Current Amount
;;
;;END
BARDUPBL ; IHS/SD/RLT - Duplicate Bill report modified from BARPT173; [ 05/25/05 ]
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1**;MAR 27,2007
+2 QUIT
+3 ; *********************************************************************
+4 ;
EN ; EP - Driver
+1 ; Look for duplicate bills
DO FINDUP
+2 ; Send dup bill message to manager
DO MAILDUP
+3 QUIT
+4 ; ********************************************************************
+5 ;
FINDUP ;
+1 ; Find possible AR Bill Multiples (duplicates)
+2 WRITE !!,"Looking for possible duplicate bills..."
+3 KILL ^BARTMP("DUP")
+4 SET BARDUZ=DUZ(2)
+5 SET DUZ(2)=0
+6 FOR
SET DUZ(2)=$ORDER(^BARBL(DUZ(2)))
IF '+DUZ(2)
QUIT
Begin DoDot:1
+7 SET BARBL=""
+8 FOR
SET BARBL=$ORDER(^BARBL(DUZ(2),"B",BARBL))
IF BARBL=""
QUIT
Begin DoDot:2
+9 SET (BARIEN,BARCNT)=0
+10 FOR
SET BARIEN=$ORDER(^BARBL(DUZ(2),"B",BARBL,BARIEN))
IF '+BARIEN
QUIT
Begin DoDot:3
+11 SET BARCNT=BARCNT+1
End DoDot:3
+12 IF BARCNT>1
SET ^BARTMP("DUP",DUZ(2),BARBL)=BARCNT
End DoDot:2
End DoDot:1
+13 SET DUZ(2)=BARDUZ
+14 QUIT
+15 ; *********************************************************************
+16 ;
MAILDUP ;
+1 ; Send a mail message to all holders of the BARZMGR key listing
+2 ; possible duplicates on their system
+3 ;
+4 WRITE !!,"Sending MailMan message to AR Managers..."
+5 DO MAILSETM
+6 DO MAILTXTM
+7 DO MAILMSGM
+8 WRITE " DONE"
+9 QUIT
+10 ; *********************************************************************
+11 ;
MAILSETM ;
+1 ; Set Mailman Variables
+2 KILL XMY
+3 SET XMSUB="Possible Duplicate A/R Bills"
+4 SET XMDUZ="Accounts Receivable Software Engineer"
+5 ; Get list of recipients
DO MAILISTM
+6 QUIT
+7 ; *********************************************************************
+8 ;
MAILISTM ;
+1 ; Find users who hold the BARZ MANAGER key
+2 ;S XMY("STAR,GLEN R")=""
+3 SET J=0
+4 FOR
SET J=$ORDER(^XUSEC("BARZ MANAGER",J))
IF '+J
QUIT
Begin DoDot:1
+5 SET BARNAME=$PIECE($GET(^VA(200,J,0)),U)
+6 SET XMY(BARNAME)=""
End DoDot:1
+7 QUIT
+8 ; *********************************************************************
+9 ;
MAILTXTM ;
+1 ; Determine body of e-mail
+2 KILL ^BARTMP("173MSG")
+3 SET K=0
+4 FOR
Begin DoDot:1
+5 SET K=K+1
+6 SET BARTXT=$PIECE($TEXT(@2+K),";;",2)
+7 IF BARTXT="END"
QUIT
+8 SET ^BARTMP("173MSG",K)=BARTXT
End DoDot:1
IF BARTXT="END"
QUIT
+9 ;
+10 ; Now get the duplicated bills
+11 ;
+12 IF '$DATA(^BARTMP("DUP"))
Begin DoDot:1
+13 SET ^BARTMP("173MSG",K+1)="***** NO DUPLICATE BILLS FOUND ****"
End DoDot:1
QUIT
+14 ;
+15 SET $PIECE(BARDASH,"-",51)=""
+16 SET $PIECE(BAREQUAL,"=",51)=""
+17 SET BARCNT=0
+18 SET BARTOT=0
+19 SET BARPAR=0
+20 FOR
SET BARPAR=$ORDER(^BARTMP("DUP",BARPAR))
IF '+BARPAR
QUIT
Begin DoDot:1
+21 SET (BARFCNT,BARFBT)=0
+22 SET K=K+1
+23 SET ^BARTMP("173MSG",K)="Parent Facility: "_$$GET1^DIQ(4,BARPAR,.01)
+24 SET K=K+1
+25 SET ^BARTMP("173MSG",K)=" "
+26 SET BARBL=""
+27 FOR
SET BARBL=$ORDER(^BARTMP("DUP",BARPAR,BARBL))
IF BARBL=""
QUIT
Begin DoDot:2
+28 SET BARFCNT=BARFCNT+1
+29 SET BARCNT=BARCNT+1
+30 SET BARBIL=$EXTRACT(BARBL,1,20)
+31 FOR I=$LENGTH(BARBIL):1:25
SET BARBIL=BARBIL_" "
+32 SET BARIEN=0
+33 FOR
SET BARIEN=$ORDER(^BARBL(BARPAR,"B",BARBL,BARIEN))
IF '+BARIEN
QUIT
Begin DoDot:3
+34 IF '$DATA(^BARBL(BARPAR,BARIEN))
QUIT
+35 SET BARIENO="'"_BARIEN
+36 FOR I=$LENGTH(BARIENO):1:10
SET BARIENO=BARIENO_" "
+37 SET BARPIEN=$PIECE($GET(^BARBL(BARPAR,BARIEN,1)),U)
+38 IF BARPIEN]""
SET BARPAT=$EXTRACT($$GET1^DIQ(9000001,BARPIEN,.01),1,20)
+39 IF BARPIEN=""
SET BARPAT=""
+40 FOR I=$LENGTH(BARPAT):1:25
SET BARPAT=BARPAT_" "
+41 ;S BARBAMT=$P($G(^BARBL(BARPAR,BARIEN,0)),U,13) ;don't use bill amt
+42 ;use current amt
SET BARBAMT=$PIECE($GET(^BARBL(BARPAR,BARIEN,0)),U,15)
+43 SET BARBAMTO=$JUSTIFY($FNUMBER(BARBAMT,",",2),15)
+44 SET K=K+1
+45 SET ^BARTMP("173MSG",K)=BARIENO_BARBIL_BARPAT_BARBAMTO
End DoDot:3
+46 ; Facility bill total
SET BARFBT=BARBAMT+BARFBT
+47 SET BARTOT=BARBAMT+BARTOT
End DoDot:2
+48 SET K=K+1
+49 SET ^BARTMP("173MSG",K)=$JUSTIFY(BARDASH,79)
+50 SET K=K+1
+51 SET ^BARTMP("173MSG",K)=$JUSTIFY("Unique bill count: ",58)_$JUSTIFY(BARFCNT,4)_$JUSTIFY($FNUMBER(BARFBT,",",2),16)
+52 SET K=K+1
+53 SET ^BARTMP("173MSG",K)=" "
End DoDot:1
+54 SET ^BARTMP("173MSG",K)=$JUSTIFY(BAREQUAL,79)
+55 SET K=K+1
+56 SET ^BARTMP("173MSG",K)=$JUSTIFY("Total unique bill count: ",58)_$JUSTIFY(BARCNT,4)_$JUSTIFY($FNUMBER(BARTOT,",",2),16)
+57 QUIT
+58 ; *********************************************************************
+59 ;
MAILMSGM ;
+1 SET XMTEXT="^BARTMP(""173MSG"","
+2 SET %H=$HOROLOG
+3 DO YX^%DTC
+4 NEW DIFROM
+5 DO ^XMD
+6 QUIT
+7 ; *********************************************************************
+8 ;
2 ;;
+1 ;;The following is a list of possible duplicate A/R Bills found on your
+2 ;;system.
+3 ;;
+4 ;; IEN Bill Patient Current Amount
+5 ;;
+6 ;;END
