- 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