BARUFFN ; IHS/SD/TPF - UFMS REPORT BY FILENAME ; 03/03/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**3,20,23**;OCT 26, 2005
Q
;
LKUP ;EP - LOOK UP BY FILENAME
F D FILENM Q:'$G(TARGET)!$G(ESC)
Q
FILENM ;
N SEARCH,TARGET,CHOICE,ITEM,MAX,LINE,ESC,PREFIX,SUFFIX
S PREFIX="IHS_AR_RPMS_RCV_"
S SUFFIX=".DAT"
D FNHDR
S $P(LINE,"-",81)=""
K DIR,DIC,DIE,DR,DA
S DIR("?",1)="Enter a file name e.g. IHS_AR_RPMS_RCV_398_113510_20070806_0847.DAT,"
S DIR("?")="or * to list all UFMS files on file in the sessioning log"
S DIR("A")="Enter a UFMS File name "
S DIR(0)="FO"
D ^DIR
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!(Y="")
;
S ESC=0
S TARGET=Y
K CHOICES
Q:Y=""
I Y="*" S SEARCH="",TARGET="" D I 1
. S (MAX,ESC,CHOICE)=0
. F ITEM=1:1 S SEARCH=$O(^BARSESS(DUZ(2),"FN",SEARCH)) Q:SEARCH=""!(ESC)!(CHOICE) D
.. S CHOICES(ITEM)=SEARCH
.. S MAX=MAX+1
.. W !,ITEM_". "_PREFIX_CHOICES(ITEM)_SUFFIX
.. I '(ITEM#10)!('$O(^BARSESS(DUZ(2),"FN",SEARCH))) D
... K DIR
... S DIR(0)="NO^1:"_MAX W !
... D ^DIR Q:Y="" S ESC=$D(DIRUT) Q:ESC
... S CHOICE=CHOICES(+Y) K CHOICES S CHOICES(1)=CHOICE
... S TARGET=PREFIX_CHOICES(1)_SUFFIX
.I ITEM=2,$D(CHOICES) D FNDATA(CHOICES(+Y)) ;G LKUP
E D
. S SEARCH=$P(TARGET,"_",5,8) ; Get ^BARSESS glo filename
. S SEARCH=$P(SEARCH,".",1) I SEARCH="" S SEARCH=TARGET
. I '$D(^BARSESS(DUZ(2),"FN",SEARCH)) W !," I can't find this FileName: ",TARGET S CHOICE=0 H 2 Q
. K FNDATA S CHOICES(1)=SEARCH,CHOICE=1
;
Q:ESC!('CHOICE)
D FNDATA(CHOICES(1))
;end new code IHS/SD/PKD
Q
;
FNDATA(FILENAME) ;EP - PULL FILE DATE
N TRANSDT,SESSID,IENS,RECORD,UDUZ,TRANSBY,APPLYTO,DELAYED
S PAGE=0
D LKUPHDR(FILENAME)
S SESSID=""
; IHS/SD/PKD 1.8*20 12/11/10 moved counter =0 above the for loop
S (TRDATE,TRCOUNT,TRTOTAL)=0
S TRFILENM=PREFIX_FILENAME
; END 1.8*20
F S SESSID=$O(^BARSESS(DUZ(2),"FN",FILENAME,SESSID)) Q:'SESSID!(ESC) D
.S UDUZ=$O(^BARSESS(DUZ(2),"FN",FILENAME,SESSID,""))
. ; IHS/SD/PKD 1.8*20 comment out page feeds
. ;I $Y>(IOSL-4) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=X=U Q:ESC D LKUPHDR(FILENAME)
.W !,SESSID
.W ?15,$E($P($G(^VA(200,UDUZ,0)),U),1,15)
.;
.; IHS/SD/PKD 1.8*20 12/11/10 Zero counters above SESSID Loop
.;S (TRDATE,TRCOUNT,TRTOTAL)=0
. S TRDATE=0
.F S TRDATE=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE)) Q:'TRDATE!(ESC) D
..S IENS=TRDATE_","
..;IHS/SD/PKD 12/11/10 1.8*20 Include only transactions for this UFMS File
..Q:(($P($G(^BARTR(DUZ(2),TRDATE,6)),U,1))'[(TRFILENM))
..S ARBILL=$$GET1^DIQ(90050.03,IENS,4,"E") ;A/R TRANSACTIONS, BILL (A/R)
..Q:ARBILL=""
..S ARCOLB=$$GET1^DIQ(90050.03,IENS,14,"E") ;A/R TRANSACTIONS, A/R COLLECTION BATCH
..S ARAMT=$$GET1^DIQ(90050.03,IENS,3.5) ;A/R TRANSACTIONS, CREDIT - DEBIT
..S TRANTYPE=$$GET1^DIQ(90050.03,IENS,101,"E") ;A/R TRANSACTIONS, TRANSACTION TYPE
..I TRANTYPE="PAYMENT" D
...S UFMSTYPE="R"
...S UFMSSIGN=$S(ARAMT>0!(ARAMT=0):"+",1:"-") ;keep sign
..E I TRANTYPE[("ADJUST")!(TRANTYPE[("REFUND")) D
...S UFMSTYPE="A"
...S UFMSSIGN=$S(ARAMT>0!(ARAMT=0):"-",1:"+")
..E Q
..S APPLYTO=$$GET1^DIQ(90057.110102,TRDATE_","_SESSID_","_UDUZ_",",.05,"E")
..S DELAYED=$D(^BARSESS(DUZ(2),"DS",TRDATE))
..S TRCOUNT=TRCOUNT+1
..I ARAMT<0 S ARAMT=UFMSSIGN_$P(ARAMT,"-",2)
..E S ARAMT=UFMSSIGN_ARAMT
..S TRTOTAL=TRTOTAL+ARAMT
..S ARCOLITM=$$GET1^DIQ(90050.03,IENS,15,"E") ;A/R TRANSACTIONS, COLLECTION ITEM
..S ARCOLIN=$$GET1^DIQ(90050.03,IENS,14,"I") ;A/R TRANSACTIONS, A/R COLLECTION BATCH PTR
..S ARCOLB=$$GET1^DIQ(90051.01,ARCOLIN_",",.01,"I") ;A/R COLLECTION BATCH, NAME
..S IPAC=$$GET1^DIQ(90051.1101,ARCOLITM_","_ARCOLIN_",",20,"I") ;A/R COLLECTION BATCH, TREASURY DEPOSIT SCHEDULE NUMBER
..S:IPAC="" IPAC="PRE-UFMS-COLLECTIONS"
..;
..S (TPBILL)=""
..I ARBILL'="" D ;SCREEN OUT TRANSACTIONS WITH NO A/R BILL
...S ARBILLIN=$$GET1^DIQ(90050.03,IENS,4,"I") ;A/R TRANSACTIONS, BILL (A/R) PTR
...S TPBIEN=$$GET1^DIQ(90050.01,ARBILLIN_",",17,"I") ;A/R BILL, 3P IEN (DA)
...S TPBDUZ2=$$GET1^DIQ(90050.01,ARBILLIN_",",22,"I") ;A/R BILL, 3P DUZ(2)
...S TPBILL=$$GET1^DIQ(9002274.4,TPBIEN_",",.01,"E") ;3P BILL, BILL NUMBER
...I TPBILL="" D
....S BARDUZ2=DUZ(2)
....S DUZ(2)=TPBDUZ2
....S TPBILL=$$GET1^DIQ(9002274.4,TPBIEN_",",.01,"E") ;3P BILL, BILL NUMBER
....S DUZ(2)=BARDUZ2
..; IHS/SD/PKD 1.8*20 comment out page feeds
..;I $Y>(IOSL-4) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=X=U Q:ESC D LKUPHDR(FILENAME)
..W !,$S(DELAYED:"*",1:"")
..W ?3,TRDATE,"["_UFMSTYPE_"]",?21,TPBILL,?30,ARCOLB,?65,$J(ARAMT,15,2)
..W !?32,IPAC,?50,APPLYTO
.Q:ESC
.; IHS/SD/PKD 1.8*20 comment out page feeds
.;K DIR
.;S DIR(0)="E"
.; D ^DIR
.W !!
.D FNDETAIL
.S RECORD=0
.F S RECORD=$O(^BARSESS(DUZ(2),"FN",FILENAME,SESSID,UDUZ,RECORD)) Q:'RECORD!(ESC) D
..S IENS=RECORD_","_SESSID_","_UDUZ_","
..S TRANSDT=$$GET1^DIQ(90057.210101,IENS,.01,"E")
..S TRANSBY=$$GET1^DIQ(90057.210101,IENS,.03,"E")
..;; IHS/SD/PKD 1.8*20 comment out page feeds - 2ND ";" piece already commented out
..;I $Y>(IOSL-4) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=X=U Q:ESC ;D LKUPHDR(FILENAME):'$O(^BARSESS(DUZ(2),"FN",FILENAME,SESSID,UDUZ,RECORD)) D FNDETAIL:$O(^BARSESS(DUZ(2),"FN",FILENAME,SESSID,UDUZ,RECORD))
..W !?35,TRANSDT
..W ?60,$E(TRANSBY,1,20)
;W !!,"TOTAL RECORDS: ",TRCOUNT,?30,"TOTAL AMOUNT: ",TRTOTAL ;bar*1.8*20 Per Gina; totals not needed on report
Q:ESC
K DIR
S DIR(0)="E"
W !
D ^DIR
Q
;
LKUPHDR(FILENAME) ;
W @IOF
S PAGE=$G(PAGE)+1
S X="VIEWING SESSIONS ASSOCIATED WITH FILE"
S X=$J("",IOM-$L(X)\2-$X)_X
W !,X
W ?70,"PAGE ",PAGE
W !
W $$CJ^XLFSTR(PREFIX_FILENAME_SUFFIX,IOM)
W $$CJ^XLFSTR("'*' DENOTES 'DELAYED SEND'",IOM)
W !!
W "SESSION ID"
W ?15,"CASHIER"
W !?2,"TRANSACTION"
W ?20,"3P BILL"
W ?30,"COL/BATCH"
W ?70,"AMT"
W !?32,"SCHED #"
W ?50,"APPLY TO"
W !,LINE
W:$G(SESSID)'="" !,SESSID
W:$G(UDUZ)'="" ?15,$E($P($G(^VA(200,UDUZ,0)),U),1,15)
Q
;
FNDETAIL ;
W !?35,"TRANSMISSION TIME"
W ?60,"SENT BY"
W !,LINE
Q
;
FNHDR ;EP - ERROR SCREEN HEADER
;W @IOF ;IHS/SD/PKD 1.8*20
W $$CJ^XLFSTR("List Transactions by File Name",IOM)
W !
Q
BARUFFN ; IHS/SD/TPF - UFMS REPORT BY FILENAME ; 03/03/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,20,23**;OCT 26, 2005
+2 QUIT
+3 ;
LKUP ;EP - LOOK UP BY FILENAME
+1 FOR
DO FILENM
IF '$GET(TARGET)!$GET(ESC)
QUIT
+2 QUIT
FILENM ;
+1 NEW SEARCH,TARGET,CHOICE,ITEM,MAX,LINE,ESC,PREFIX,SUFFIX
+2 SET PREFIX="IHS_AR_RPMS_RCV_"
+3 SET SUFFIX=".DAT"
+4 DO FNHDR
+5 SET $PIECE(LINE,"-",81)=""
+6 KILL DIR,DIC,DIE,DR,DA
+7 SET DIR("?",1)="Enter a file name e.g. IHS_AR_RPMS_RCV_398_113510_20070806_0847.DAT,"
+8 SET DIR("?")="or * to list all UFMS files on file in the sessioning log"
+9 SET DIR("A")="Enter a UFMS File name "
+10 SET DIR(0)="FO"
+11 DO ^DIR
+12 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+13 ;
+14 SET ESC=0
+15 SET TARGET=Y
+16 KILL CHOICES
+17 IF Y=""
QUIT
+18 IF Y="*"
SET SEARCH=""
SET TARGET=""
Begin DoDot:1
+19 SET (MAX,ESC,CHOICE)=0
+20 FOR ITEM=1:1
SET SEARCH=$ORDER(^BARSESS(DUZ(2),"FN",SEARCH))
IF SEARCH=""!(ESC)!(CHOICE)
QUIT
Begin DoDot:2
+21 SET CHOICES(ITEM)=SEARCH
+22 SET MAX=MAX+1
+23 WRITE !,ITEM_". "_PREFIX_CHOICES(ITEM)_SUFFIX
+24 IF '(ITEM#10)!('$ORDER(^BARSESS(DUZ(2),"FN",SEARCH)))
Begin DoDot:3
+25 KILL DIR
+26 SET DIR(0)="NO^1:"_MAX
WRITE !
+27 DO ^DIR
IF Y=""
QUIT
SET ESC=$DATA(DIRUT)
IF ESC
QUIT
+28 SET CHOICE=CHOICES(+Y)
KILL CHOICES
SET CHOICES(1)=CHOICE
+29 SET TARGET=PREFIX_CHOICES(1)_SUFFIX
End DoDot:3
End DoDot:2
+30 ;G LKUP
IF ITEM=2
IF $DATA(CHOICES)
DO FNDATA(CHOICES(+Y))
End DoDot:1
IF 1
+31 IF '$TEST
Begin DoDot:1
+32 ; Get ^BARSESS glo filename
SET SEARCH=$PIECE(TARGET,"_",5,8)
+33 SET SEARCH=$PIECE(SEARCH,".",1)
IF SEARCH=""
SET SEARCH=TARGET
+34 IF '$DATA(^BARSESS(DUZ(2),"FN",SEARCH))
WRITE !," I can't find this FileName: ",TARGET
SET CHOICE=0
HANG 2
QUIT
+35 KILL FNDATA
SET CHOICES(1)=SEARCH
SET CHOICE=1
End DoDot:1
+36 ;
+37 IF ESC!('CHOICE)
QUIT
+38 DO FNDATA(CHOICES(1))
+39 ;end new code IHS/SD/PKD
+40 QUIT
+41 ;
FNDATA(FILENAME) ;EP - PULL FILE DATE
+1 NEW TRANSDT,SESSID,IENS,RECORD,UDUZ,TRANSBY,APPLYTO,DELAYED
+2 SET PAGE=0
+3 DO LKUPHDR(FILENAME)
+4 SET SESSID=""
+5 ; IHS/SD/PKD 1.8*20 12/11/10 moved counter =0 above the for loop
+6 SET (TRDATE,TRCOUNT,TRTOTAL)=0
+7 SET TRFILENM=PREFIX_FILENAME
+8 ; END 1.8*20
+9 FOR
SET SESSID=$ORDER(^BARSESS(DUZ(2),"FN",FILENAME,SESSID))
IF 'SESSID!(ESC)
QUIT
Begin DoDot:1
+10 SET UDUZ=$ORDER(^BARSESS(DUZ(2),"FN",FILENAME,SESSID,""))
+11 ; IHS/SD/PKD 1.8*20 comment out page feeds
+12 ;I $Y>(IOSL-4) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=X=U Q:ESC D LKUPHDR(FILENAME)
+13 WRITE !,SESSID
+14 WRITE ?15,$EXTRACT($PIECE($GET(^VA(200,UDUZ,0)),U),1,15)
+15 ;
+16 ; IHS/SD/PKD 1.8*20 12/11/10 Zero counters above SESSID Loop
+17 ;S (TRDATE,TRCOUNT,TRTOTAL)=0
+18 SET TRDATE=0
+19 FOR
SET TRDATE=$ORDER(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE))
IF 'TRDATE!(ESC)
QUIT
Begin DoDot:2
+20 SET IENS=TRDATE_","
+21 ;IHS/SD/PKD 12/11/10 1.8*20 Include only transactions for this UFMS File
+22 IF (($PIECE($GET(^BARTR(DUZ(2),TRDATE,6)),U,1))'[(TRFILENM))
QUIT
+23 ;A/R TRANSACTIONS, BILL (A/R)
SET ARBILL=$$GET1^DIQ(90050.03,IENS,4,"E")
+24 IF ARBILL=""
QUIT
+25 ;A/R TRANSACTIONS, A/R COLLECTION BATCH
SET ARCOLB=$$GET1^DIQ(90050.03,IENS,14,"E")
+26 ;A/R TRANSACTIONS, CREDIT - DEBIT
SET ARAMT=$$GET1^DIQ(90050.03,IENS,3.5)
+27 ;A/R TRANSACTIONS, TRANSACTION TYPE
SET TRANTYPE=$$GET1^DIQ(90050.03,IENS,101,"E")
+28 IF TRANTYPE="PAYMENT"
Begin DoDot:3
+29 SET UFMSTYPE="R"
+30 ;keep sign
SET UFMSSIGN=$SELECT(ARAMT>0!(ARAMT=0):"+",1:"-")
End DoDot:3
+31 IF '$TEST
IF TRANTYPE[("ADJUST")!(TRANTYPE[("REFUND"))
Begin DoDot:3
+32 SET UFMSTYPE="A"
+33 SET UFMSSIGN=$SELECT(ARAMT>0!(ARAMT=0):"-",1:"+")
End DoDot:3
+34 IF '$TEST
QUIT
+35 SET APPLYTO=$$GET1^DIQ(90057.110102,TRDATE_","_SESSID_","_UDUZ_",",.05,"E")
+36 SET DELAYED=$DATA(^BARSESS(DUZ(2),"DS",TRDATE))
+37 SET TRCOUNT=TRCOUNT+1
+38 IF ARAMT<0
SET ARAMT=UFMSSIGN_$PIECE(ARAMT,"-",2)
+39 IF '$TEST
SET ARAMT=UFMSSIGN_ARAMT
+40 SET TRTOTAL=TRTOTAL+ARAMT
+41 ;A/R TRANSACTIONS, COLLECTION ITEM
SET ARCOLITM=$$GET1^DIQ(90050.03,IENS,15,"E")
+42 ;A/R TRANSACTIONS, A/R COLLECTION BATCH PTR
SET ARCOLIN=$$GET1^DIQ(90050.03,IENS,14,"I")
+43 ;A/R COLLECTION BATCH, NAME
SET ARCOLB=$$GET1^DIQ(90051.01,ARCOLIN_",",.01,"I")
+44 ;A/R COLLECTION BATCH, TREASURY DEPOSIT SCHEDULE NUMBER
SET IPAC=$$GET1^DIQ(90051.1101,ARCOLITM_","_ARCOLIN_",",20,"I")
+45 IF IPAC=""
SET IPAC="PRE-UFMS-COLLECTIONS"
+46 ;
+47 SET (TPBILL)=""
+48 ;SCREEN OUT TRANSACTIONS WITH NO A/R BILL
IF ARBILL'=""
Begin DoDot:3
+49 ;A/R TRANSACTIONS, BILL (A/R) PTR
SET ARBILLIN=$$GET1^DIQ(90050.03,IENS,4,"I")
+50 ;A/R BILL, 3P IEN (DA)
SET TPBIEN=$$GET1^DIQ(90050.01,ARBILLIN_",",17,"I")
+51 ;A/R BILL, 3P DUZ(2)
SET TPBDUZ2=$$GET1^DIQ(90050.01,ARBILLIN_",",22,"I")
+52 ;3P BILL, BILL NUMBER
SET TPBILL=$$GET1^DIQ(9002274.4,TPBIEN_",",.01,"E")
+53 IF TPBILL=""
Begin DoDot:4
+54 SET BARDUZ2=DUZ(2)
+55 SET DUZ(2)=TPBDUZ2
+56 ;3P BILL, BILL NUMBER
SET TPBILL=$$GET1^DIQ(9002274.4,TPBIEN_",",.01,"E")
+57 SET DUZ(2)=BARDUZ2
End DoDot:4
End DoDot:3
+58 ; IHS/SD/PKD 1.8*20 comment out page feeds
+59 ;I $Y>(IOSL-4) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=X=U Q:ESC D LKUPHDR(FILENAME)
+60 WRITE !,$SELECT(DELAYED:"*",1:"")
+61 WRITE ?3,TRDATE,"["_UFMSTYPE_"]",?21,TPBILL,?30,ARCOLB,?65,$JUSTIFY(ARAMT,15,2)
+62 WRITE !?32,IPAC,?50,APPLYTO
End DoDot:2
+63 IF ESC
QUIT
+64 ; IHS/SD/PKD 1.8*20 comment out page feeds
+65 ;K DIR
+66 ;S DIR(0)="E"
+67 ; D ^DIR
+68 WRITE !!
+69 DO FNDETAIL
+70 SET RECORD=0
+71 FOR
SET RECORD=$ORDER(^BARSESS(DUZ(2),"FN",FILENAME,SESSID,UDUZ,RECORD))
IF 'RECORD!(ESC)
QUIT
Begin DoDot:2
+72 SET IENS=RECORD_","_SESSID_","_UDUZ_","
+73 SET TRANSDT=$$GET1^DIQ(90057.210101,IENS,.01,"E")
+74 SET TRANSBY=$$GET1^DIQ(90057.210101,IENS,.03,"E")
+75 ;; IHS/SD/PKD 1.8*20 comment out page feeds - 2ND ";" piece already commented out
+76 ;I $Y>(IOSL-4) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=X=U Q:ESC ;D LKUPHDR(FILENAME):'$O(^BARSESS(DUZ(2),"FN",FILENAME,SESSID,UDUZ,RECORD)) D FNDETAIL:$O(^BARSESS(DUZ(2),"FN",FILENAME,SESSID,UDUZ,RECORD))
+77 WRITE !?35,TRANSDT
+78 WRITE ?60,$EXTRACT(TRANSBY,1,20)
End DoDot:2
End DoDot:1
+79 ;W !!,"TOTAL RECORDS: ",TRCOUNT,?30,"TOTAL AMOUNT: ",TRTOTAL ;bar*1.8*20 Per Gina; totals not needed on report
+80 IF ESC
QUIT
+81 KILL DIR
+82 SET DIR(0)="E"
+83 WRITE !
+84 DO ^DIR
+85 QUIT
+86 ;
LKUPHDR(FILENAME) ;
+1 WRITE @IOF
+2 SET PAGE=$GET(PAGE)+1
+3 SET X="VIEWING SESSIONS ASSOCIATED WITH FILE"
+4 SET X=$JUSTIFY("",IOM-$LENGTH(X)\2-$X)_X
+5 WRITE !,X
+6 WRITE ?70,"PAGE ",PAGE
+7 WRITE !
+8 WRITE $$CJ^XLFSTR(PREFIX_FILENAME_SUFFIX,IOM)
+9 WRITE $$CJ^XLFSTR("'*' DENOTES 'DELAYED SEND'",IOM)
+10 WRITE !!
+11 WRITE "SESSION ID"
+12 WRITE ?15,"CASHIER"
+13 WRITE !?2,"TRANSACTION"
+14 WRITE ?20,"3P BILL"
+15 WRITE ?30,"COL/BATCH"
+16 WRITE ?70,"AMT"
+17 WRITE !?32,"SCHED #"
+18 WRITE ?50,"APPLY TO"
+19 WRITE !,LINE
+20 IF $GET(SESSID)'=""
WRITE !,SESSID
+21 IF $GET(UDUZ)'=""
WRITE ?15,$EXTRACT($PIECE($GET(^VA(200,UDUZ,0)),U),1,15)
+22 QUIT
+23 ;
FNDETAIL ;
+1 WRITE !?35,"TRANSMISSION TIME"
+2 WRITE ?60,"SENT BY"
+3 WRITE !,LINE
+4 QUIT
+5 ;
FNHDR ;EP - ERROR SCREEN HEADER
+1 ;W @IOF ;IHS/SD/PKD 1.8*20
+2 WRITE $$CJ^XLFSTR("List Transactions by File Name",IOM)
+3 WRITE !
+4 QUIT
