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

BARUFUT0.m

Go to the documentation of this file. 
  1. BARUFUT0 ; IHS/SD/TPF - UTILITIES FOR UFMS (CONTINUATION OF BARUFUT) ; 09/19/2007
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**7,20**;OCT 26, 2005
  1.  ;NEW ROUTINE TO MEET SAC REQUIREMENT FOR ROUTINE SIZE; BAR*1.8*7
  1.  Q
  1.  ;
  1. VIEWTRAN(UDUZ,SESSID,ERASTAT) ;EP - VIEW INDIVIDUAL SESSION TRANSACTIONS
  1.  N TRDATE,LINE,CREDIT,DEBIT,TRANTYP,ADJCAT,DATE,BILL,CURSTAT,TRANBY,TRANS,IEN,TRANTIME
  1.  N ESCAPE
  1.  S ESCAPE=0
  1.  K TRANS
  1.  D TRANHDR(UDUZ,SESSID)
  1.  S TRDATE=0
  1.  F LINE=1:1 S TRDATE=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE)) Q:'TRDATE!(ESCAPE)  D
  1.  .S IENS=TRDATE_","_SESSID_","_UDUZ_","
  1.  .S TRANS=$$GET1^DIQ(90057.110102,IENS,.02,"E")
  1.  .S TRANBY=$$GET1^DIQ(90057.110102,IENS,.03,"E")
  1.  .S TRANTIME=$$GET1^DIQ(90057.110102,IENS,.04,"E")
  1.  .S CREDIT=$$GET1^DIQ(90050.03,TRDATE_",",2)
  1.  .S DEBIT=$$GET1^DIQ(90050.03,TRDATE_",",3)
  1.  .S BILL=$$GET1^DIQ(90050.03,TRDATE_",",4)
  1.  .S BLLIEN=$$GET1^DIQ(90050.03,TRDATE_",",4,"I")
  1.  .S TPBIEN=$$GET1^DIQ(90050.01,BLLIEN_",",17,"I")
  1.  .S TRANTYP=$$GET1^DIQ(90050.03,TRDATE_",",101,"E")
  1.  .S ADJCAT=$$GET1^DIQ(90050.03,TRDATE_",",102,"E")
  1.  .S TRANS(LINE)=TRDATE
  1.  .I $Y>(IOSL-5) D ASKFORRT^BARUFUT S ESCAPE=$D(DIROUT)!$D(DUOUT)!$D(DTOUT) D TRANHDR(UDUZ,SESSID)
  1.  .W !,LINE,"."
  1.  .S Y=TRDATE X ^DD("DD") S DATE=Y
  1.  .W ?4,DATE,?25,$J(CREDIT,8,2),?35,$J(DEBIT,8,2),?50,$E(TRANTYP,1,14),?65,$E(ADJCAT,1,15)
  1.  .W:BILL'="" !?4,BILL
  1.  .W:TPBIEN'="" !?4,"["_TPBIEN_"]"
  1.  .W:TRANS="YES" ?25,"TRANSMITTED BY: ",TRANBY," on ",TRANTIME
  1.  D ASKFORRT^BARUFUT
  1.  Q
  1.  ;
  1. TRANHDR(UDUZ,SESSID) ;EP - VIEW STATUS HEADER
  1.  W @IOF
  1.  W !?3,"VIEWING TRANSACTIONS FOR SESSION ID ",SESSID," OF ",$P($G(^VA(200,UDUZ,0)),U)
  1.  W !?3,"A/R TRANSACTION DATE",?29,"CREDIT",?39,"DEBIT",?50,"TYPE",?65,"CATEGORY"
  1.  W !?3,"A/R BILL"
  1.  W !?3,"--------------------",?29,"------",?39,"-----",?50,"----",?65,"--------"
  1.  W !
  1.  Q
  1. VIEWSTAT(UDUZ,SESSID) ;EP - VIEW STATUS HISTORY
  1.  N STATUSDT,STATDTEX,CHANGETO,CHANGBY
  1.  D STATHDR(UDUZ,SESSID)
  1.  S STATUSDT=0
  1.  F  S STATUSDT=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,1,STATUSDT)) Q:'STATUSDT  D
  1.  .S CHANGETO=$$GET1^DIQ(90057.110101,STATUSDT_","_SESSID_","_UDUZ_",",.02,"E")
  1.  .S CHANGEBY=$$GET1^DIQ(90057.110101,STATUSDT_","_SESSID_","_UDUZ_",",.03,"E")
  1.  .S Y=STATUSDT X ^DD("DD") S STATDTEX=Y
  1.  .I $Y>(IOSL-8) D ASKFORRT^BARUFUT D STATHDR(UDUZ,SESSID) Q
  1.  .W !,STATDTEX,?25,$E(CHANGEBY,1,20),?50,CHANGETO
  1.  D ASKFORRT^BARUFUT
  1.  Q
  1. STATHDR(UDUZ,SESSID) ;EP - VIEW STATUS HEADER
  1.  W @IOF
  1.  W !,"VIEWING STATUS HISTORY FOR SESSION ID ",SESSID," OF ",$P($G(^VA(200,UDUZ,0)),U)
  1.  W !,"STATUS CHANGED ON",?25,"CHANGED BY",?50,"CHANGED TO"
  1.  W !,"-----------------",?25,"----------",?50,"----------",!
  1.  Q
  1.  ;
  1. SETTRANS(UDUZ,SESSID,BARFILE) ;EP - SET TRANSMISSION DATE/TIME MULTIPLE;MRS:BAR*1.8*7 IM30562
  1.  ;ADDED NEW FUNCTIONALITY TO PREVENT DUPLICATES  ;MRS:BAR*1.8*7 IM30562
  1.  N NEWSTAT
  1.  K DIR,DIE,DIC,DR,DA
  1.  D NOW^%DTC
  1.  S X=%
  1.  I $D(SESSID)=1 D  Q 1                    ;SET AND UNLOCK SINGLE SESSION
  1.  .D SET(UDUZ,SESSID)
  1.  .LOCK -^BARSESS(DUZ(2),UDUZ,11,SESSID)
  1.  S REC=""
  1.  F  S REC=$O(SESSID(REC)) Q:'REC  D       ;SET AND UNLOCK MULTIPLE SESSIONS
  1.  .S UDUZ=$P(SESSID(REC),U)
  1.  .S SESSID=$P(SESSID(REC),U,2)
  1.  .D SET(UDUZ,SESSID)
  1.  .LOCK -^BARSESS(DUZ(2),UDUZ,11,SESSID)
  1.  Q 1
  1.  ;
  1. SET(UDUZ,SESSID) ;EP -
  1.  ;start new IHS/SD/PKD 3/2/11 1.8*20
  1.  ; UDUZ = SESSION CASHIER, NOT EXPORTING CASHIER
  1.  ; FILENAME Was not being set for Not Sent TRX (here from SET^BARUFEXT0)
  1.  N CHK21
  1.  S CHK21=$$CHK21(UDUZ,SESSID) Q:CHK21
  1.  ;end new
  1.  K DIR,DIE,DIC,DR,DA
  1.  D NOW^%DTC
  1.  S X=%
  1.  S DA(2)=UDUZ
  1.  S DA(1)=SESSID
  1.  S DIC("P")=$P(^DD(90057.11,210101,0),U,2)
  1.  S DIC="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",21,"
  1.  S DIC(0)="L"
  1.  D ^DIC
  1.  Q:Y<0
  1.  K DIR,DIE,DIC,DR,DA
  1.  S DA(2)=UDUZ
  1.  S DA(1)=SESSID
  1.  S DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",21,"
  1.  S DR=".02///^S X=BARFILE;.03////^S X=DUZ"
  1.  S DA=+Y
  1.  D ^DIE
  1.  K DIR,DIE,DIC,DR,DA
  1.  S CURSTAT=$$CURSTAT^BARUFUT(UDUZ,SESSID,"E")
  1.  ; IHS/SD/PKD 1.8*20 3/3/11 Remnant:  No longer use RETRANSMITTED
  1.  ;     TRANSMITTED Timestamp = 1st EXPORT timestamp - DON'T change
  1.  ;I CURSTAT="TRANSMITTED"!(CURSTAT="RETRANSMITTED") S RETCODE=$$SETSESS^BARUFUT(UDUZ,SESSID,"RT") Q
  1.  I CURSTAT["TRANSMITTED" S RETCODE=1 Q
  1.  ;END 1.8*20
  1.  S X=$$SETSESS^BARUFUT(UDUZ,SESSID,"T")
  1.  Q
  1.  ;
  1. ADDSTAT(UDUZ,SESSID) ; EP - ;CREATE A NEW STATUS CHANGE DATE/TIME
  1.  K DIC,DIE,DR,DA,DIR
  1.  D NOW^%DTC
  1.  S X=%
  1.  S DA(2)=UDUZ
  1.  S DA(1)=SESSID
  1.  S DIC("P")=$P(^DD(90057.11,110101,0),U,2)
  1.  S DIC="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",1,"
  1.  S DIC(0)="L"
  1.  D ^DIC
  1.  Q:Y<0 0
  1.  Q Y
  1.  ;start new code IHS/SD/PKD bar*1.8*20
  1. CHK21(UDUZ,SESSID)  ;IHS/SD/PKD 3/2/11 Check for previous set of FILENAME
  1.  ;into ^BARSESS(DUZ(2),USER,11,SESSID,21,COUNT,0)
  1.  ;Don't want duplicates but don't want to miss any
  1.  N CT,OK S CT=0,OK=0
  1.  F  S CT=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,21,CT)) Q:'CT!(OK)  D
  1.  . S FL=$G(^BARSESS(DUZ(2),UDUZ,11,SESSID,21,CT,0)) Q:'FL  D
  1.  . . I $P(FL,U,2)=BARFILE S OK=1
  1.  Q OK
  1.  ;end new code