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