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

BARUFFN.m

Go to the documentation of this file. 
  1. BARUFFN ; IHS/SD/TPF - UFMS REPORT BY FILENAME ; 03/03/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,20,23**;OCT 26, 2005
  1.  Q
  1.  ;
  1. LKUP ;EP - LOOK UP BY FILENAME
  1.  F  D FILENM Q:'$G(TARGET)!$G(ESC)
  1.  Q
  1. FILENM ;
  1.  N SEARCH,TARGET,CHOICE,ITEM,MAX,LINE,ESC,PREFIX,SUFFIX
  1.  S PREFIX="IHS_AR_RPMS_RCV_"
  1.  S SUFFIX=".DAT"
  1.  D FNHDR
  1.  S $P(LINE,"-",81)=""
  1.  K DIR,DIC,DIE,DR,DA
  1.  S DIR("?",1)="Enter a file name e.g. IHS_AR_RPMS_RCV_398_113510_20070806_0847.DAT,"
  1.  S DIR("?")="or * to list all UFMS files on file in the sessioning log"
  1.  S DIR("A")="Enter a UFMS File name "
  1.  S DIR(0)="FO"
  1.  D ^DIR
  1.  Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!(Y="")
  1.  ;
  1.  S ESC=0
  1.  S TARGET=Y
  1.  K CHOICES
  1.  Q:Y=""
  1.  I Y="*" S SEARCH="",TARGET="" D  I 1
  1.  . S (MAX,ESC,CHOICE)=0
  1.  . F ITEM=1:1 S SEARCH=$O(^BARSESS(DUZ(2),"FN",SEARCH)) Q:SEARCH=""!(ESC)!(CHOICE)  D
  1.  .. S CHOICES(ITEM)=SEARCH
  1.  .. S MAX=MAX+1
  1.  .. W !,ITEM_". "_PREFIX_CHOICES(ITEM)_SUFFIX
  1.  .. I '(ITEM#10)!('$O(^BARSESS(DUZ(2),"FN",SEARCH))) D
  1.  ... K DIR
  1.  ... S DIR(0)="NO^1:"_MAX W !
  1.  ... D ^DIR Q:Y=""  S ESC=$D(DIRUT) Q:ESC
  1.  ... S CHOICE=CHOICES(+Y) K CHOICES S CHOICES(1)=CHOICE
  1.  ... S TARGET=PREFIX_CHOICES(1)_SUFFIX
  1.  .I ITEM=2,$D(CHOICES) D FNDATA(CHOICES(+Y)) ;G LKUP
  1.  E  D
  1.  . S SEARCH=$P(TARGET,"_",5,8)  ; Get ^BARSESS glo filename
  1.  . S SEARCH=$P(SEARCH,".",1) I SEARCH="" S SEARCH=TARGET
  1.  . I '$D(^BARSESS(DUZ(2),"FN",SEARCH)) W !,"  I can't find this FileName: ",TARGET S CHOICE=0 H 2 Q
  1.  . K FNDATA S CHOICES(1)=SEARCH,CHOICE=1
  1.  ;
  1.  Q:ESC!('CHOICE)
  1.  D FNDATA(CHOICES(1))
  1.  ;end new code IHS/SD/PKD
  1.  Q
  1.  ;
  1. FNDATA(FILENAME) ;EP - PULL FILE DATE
  1.  N TRANSDT,SESSID,IENS,RECORD,UDUZ,TRANSBY,APPLYTO,DELAYED
  1.  S PAGE=0
  1.  D LKUPHDR(FILENAME)
  1.  S SESSID=""
  1.  ; IHS/SD/PKD 1.8*20 12/11/10 moved counter =0 above the for loop
  1.  S (TRDATE,TRCOUNT,TRTOTAL)=0
  1.  S TRFILENM=PREFIX_FILENAME
  1.  ; END 1.8*20
  1.  F  S SESSID=$O(^BARSESS(DUZ(2),"FN",FILENAME,SESSID)) Q:'SESSID!(ESC)  D
  1.  .S UDUZ=$O(^BARSESS(DUZ(2),"FN",FILENAME,SESSID,""))
  1.  . ; IHS/SD/PKD 1.8*20 comment out page feeds
  1.  . ;I $Y>(IOSL-4) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=X=U Q:ESC  D LKUPHDR(FILENAME)
  1.  .W !,SESSID
  1.  .W ?15,$E($P($G(^VA(200,UDUZ,0)),U),1,15)
  1.  .;
  1.  .; IHS/SD/PKD 1.8*20 12/11/10 Zero counters above SESSID Loop
  1.  .;S (TRDATE,TRCOUNT,TRTOTAL)=0
  1.  . S TRDATE=0
  1.  .F  S TRDATE=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE)) Q:'TRDATE!(ESC)  D
  1.  ..S IENS=TRDATE_","
  1.  ..;IHS/SD/PKD 12/11/10 1.8*20 Include only transactions for this UFMS File
  1.  ..Q:(($P($G(^BARTR(DUZ(2),TRDATE,6)),U,1))'[(TRFILENM))
  1.  ..S ARBILL=$$GET1^DIQ(90050.03,IENS,4,"E")      ;A/R TRANSACTIONS, BILL (A/R)
  1.  ..Q:ARBILL=""
  1.  ..S ARCOLB=$$GET1^DIQ(90050.03,IENS,14,"E")      ;A/R TRANSACTIONS, A/R COLLECTION BATCH
  1.  ..S ARAMT=$$GET1^DIQ(90050.03,IENS,3.5)      ;A/R TRANSACTIONS, CREDIT - DEBIT
  1.  ..S TRANTYPE=$$GET1^DIQ(90050.03,IENS,101,"E")  ;A/R TRANSACTIONS, TRANSACTION TYPE
  1.  ..I TRANTYPE="PAYMENT" D
  1.  ...S UFMSTYPE="R"
  1.  ...S UFMSSIGN=$S(ARAMT>0!(ARAMT=0):"+",1:"-")            ;keep sign
  1.  ..E  I TRANTYPE[("ADJUST")!(TRANTYPE[("REFUND")) D
  1.  ...S UFMSTYPE="A"
  1.  ...S UFMSSIGN=$S(ARAMT>0!(ARAMT=0):"-",1:"+")
  1.  ..E  Q
  1.  ..S APPLYTO=$$GET1^DIQ(90057.110102,TRDATE_","_SESSID_","_UDUZ_",",.05,"E")
  1.  ..S DELAYED=$D(^BARSESS(DUZ(2),"DS",TRDATE))
  1.  ..S TRCOUNT=TRCOUNT+1
  1.  ..I ARAMT<0 S ARAMT=UFMSSIGN_$P(ARAMT,"-",2)
  1.  ..E  S ARAMT=UFMSSIGN_ARAMT
  1.  ..S TRTOTAL=TRTOTAL+ARAMT
  1.  ..S ARCOLITM=$$GET1^DIQ(90050.03,IENS,15,"E")      ;A/R TRANSACTIONS, COLLECTION ITEM
  1.  ..S ARCOLIN=$$GET1^DIQ(90050.03,IENS,14,"I")    ;A/R TRANSACTIONS, A/R COLLECTION BATCH PTR
  1.  ..S ARCOLB=$$GET1^DIQ(90051.01,ARCOLIN_",",.01,"I")     ;A/R COLLECTION BATCH, NAME
  1.  ..S IPAC=$$GET1^DIQ(90051.1101,ARCOLITM_","_ARCOLIN_",",20,"I")     ;A/R COLLECTION BATCH, TREASURY DEPOSIT SCHEDULE NUMBER
  1.  ..S:IPAC="" IPAC="PRE-UFMS-COLLECTIONS"
  1.  ..;
  1.  ..S (TPBILL)=""
  1.  ..I ARBILL'="" D                                    ;SCREEN OUT TRANSACTIONS WITH NO A/R BILL
  1.  ...S ARBILLIN=$$GET1^DIQ(90050.03,IENS,4,"I")      ;A/R TRANSACTIONS, BILL (A/R) PTR
  1.  ...S TPBIEN=$$GET1^DIQ(90050.01,ARBILLIN_",",17,"I")  ;A/R BILL, 3P IEN (DA)
  1.  ...S TPBDUZ2=$$GET1^DIQ(90050.01,ARBILLIN_",",22,"I")  ;A/R BILL, 3P DUZ(2) 
  1.  ...S TPBILL=$$GET1^DIQ(9002274.4,TPBIEN_",",.01,"E")  ;3P BILL, BILL NUMBER
  1.  ...I TPBILL="" D
  1.  ....S BARDUZ2=DUZ(2)
  1.  ....S DUZ(2)=TPBDUZ2
  1.  ....S TPBILL=$$GET1^DIQ(9002274.4,TPBIEN_",",.01,"E")  ;3P BILL, BILL NUMBER
  1.  ....S DUZ(2)=BARDUZ2
  1.  ..; IHS/SD/PKD 1.8*20 comment out page feeds
  1.  ..;I $Y>(IOSL-4) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=X=U Q:ESC  D LKUPHDR(FILENAME)
  1.  ..W !,$S(DELAYED:"*",1:"")
  1.  ..W ?3,TRDATE,"["_UFMSTYPE_"]",?21,TPBILL,?30,ARCOLB,?65,$J(ARAMT,15,2)
  1.  ..W !?32,IPAC,?50,APPLYTO
  1.  .Q:ESC
  1.  .; IHS/SD/PKD 1.8*20 comment out page feeds
  1.  .;K DIR
  1.  .;S DIR(0)="E"
  1.  .; D ^DIR
  1.  .W !!
  1.  .D FNDETAIL
  1.  .S RECORD=0
  1.  .F  S RECORD=$O(^BARSESS(DUZ(2),"FN",FILENAME,SESSID,UDUZ,RECORD)) Q:'RECORD!(ESC)  D
  1.  ..S IENS=RECORD_","_SESSID_","_UDUZ_","
  1.  ..S TRANSDT=$$GET1^DIQ(90057.210101,IENS,.01,"E")
  1.  ..S TRANSBY=$$GET1^DIQ(90057.210101,IENS,.03,"E")
  1.  ..;; IHS/SD/PKD 1.8*20 comment out page feeds - 2ND ";" piece already commented out
  1.  ..;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))
  1.  ..W !?35,TRANSDT
  1.  ..W ?60,$E(TRANSBY,1,20)
  1.  ;W !!,"TOTAL RECORDS: ",TRCOUNT,?30,"TOTAL AMOUNT: ",TRTOTAL  ;bar*1.8*20 Per Gina; totals not needed on report
  1.  Q:ESC
  1.  K DIR
  1.  S DIR(0)="E"
  1.  W !
  1.  D ^DIR
  1.  Q
  1.  ;
  1. LKUPHDR(FILENAME) ;
  1.  W @IOF
  1.  S PAGE=$G(PAGE)+1
  1.  S X="VIEWING SESSIONS ASSOCIATED WITH FILE"
  1.  S X=$J("",IOM-$L(X)\2-$X)_X
  1.  W !,X
  1.  W ?70,"PAGE ",PAGE
  1.  W !
  1.  W $$CJ^XLFSTR(PREFIX_FILENAME_SUFFIX,IOM)
  1.  W $$CJ^XLFSTR("'*' DENOTES 'DELAYED SEND'",IOM)
  1.  W !!
  1.  W "SESSION ID"
  1.  W ?15,"CASHIER"
  1.  W !?2,"TRANSACTION"
  1.  W ?20,"3P BILL"
  1.  W ?30,"COL/BATCH"
  1.  W ?70,"AMT"
  1.  W !?32,"SCHED #"
  1.  W ?50,"APPLY TO"
  1.  W !,LINE
  1.  W:$G(SESSID)'="" !,SESSID
  1.  W:$G(UDUZ)'="" ?15,$E($P($G(^VA(200,UDUZ,0)),U),1,15)
  1.  Q
  1.  ;
  1. FNDETAIL ;
  1.  W !?35,"TRANSMISSION TIME"
  1.  W ?60,"SENT BY"
  1.  W !,LINE
  1.  Q
  1.  ;
  1. FNHDR ;EP - ERROR SCREEN HEADER
  1.  ;W @IOF  ;IHS/SD/PKD 1.8*20
  1.  W $$CJ^XLFSTR("List Transactions by File Name",IOM)
  1.  W !
  1.  Q