BARUFUTZ ; IHS/SD/TPF - UTILITY TO CLEAR TRANSMITTED FLAGS ; 12/12/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**10**;OCT 26, 2005
;NEW ROUTINE ;MRS:BAR*1.8*10 D148-2
Q
;
EN ;EP; CLEAR TRANSMITTED FLAGS TO ALLOW RE-TRANSMISSION
; ********************************************************************
K BAR
N BARFILE,UDUZ,BARID,BARN
S BARFILE=$$FILE ;GET FILE NAME
I BARFILE=0 D MSG(0) Q
;
D SESS(BARFILE) ;BUILD ARRAY OF SESSIONS
I '$D(BAR) D MSG(2) Q
;
S UDUZ=0
F S UDUZ=$O(BAR(UDUZ)) Q:'UDUZ D
.S BARID=0
.F S BARID=$O(BAR(UDUZ,BARID)) Q:BARID="" D
DIAG ..W !,UDUZ,"@",BARID,"@"
..S BARN=0
..F S BARN=$O(BAR(UDUZ,BARID,BARN)) Q:'BARN D
...S BARFNM=BAR(UDUZ,BARID,BARN)
...W BARFNM
...D CLEAR(UDUZ,BARID) ;CLEAR FLAGS
...K ^BARSESS(DUZ(2),"FN",BARFNM,BARID,UDUZ,BARN) ;CLEAR "FN" CROSS-REFERENCE
W !,"SESSIONS CLEARED "
D EOP^BARUTL(1)
Q
;
SESS(BARFILE) ;FIND UDUZ AND SESSIONS IN FILE
;Example of FN cross-reference
;^BARSESS(1575,"FN","835_232101_20081031_122246",3081031.122134,835,1)
N BARFN,BARID,BARZ,BARN
I '$D(^BARSESS(DUZ(2),"FN")) D MSG(1) Q
S BARFN=0 ;ABREVIATED FILE NAME
F S BARFN=$O(^BARSESS(DUZ(2),"FN",BARFN)) Q:'BARFN D
.Q:BARFILE'[BARFN ;NOT CORRECT FILE
.S BARID=0 ;SESSION ID
.F S BARID=$O(^BARSESS(DUZ(2),"FN",BARFN,BARID)) Q:BARID="" D
..S BARZ=0 ;UDUZ OF CASHIER
..F S BARZ=$O(^BARSESS(DUZ(2),"FN",BARFN,BARID,BARZ)) Q:'BARZ D
...S BARN=0 ;MULTIPLE IDEX
...F S BARN=$O(^BARSESS(DUZ(2),"FN",BARFN,BARID,BARZ,BARN)) Q:'BARN D
....S BAR(BARZ,BARID,BARN)=BARFN ;RE-ORDER
Q
; ********************************************************************
;
DELSFLG(UDUZ,SESSID,DA) ;EP - DELETE SESSION 'TRANSMITTED DATE' FLAG
;
K DIR,DIE,DR,DIC
S DA(2)=UDUZ
S DA(1)=SESSID
S DR=".04///@"
S DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
D ^DIE
Q
; ********************************************************************
;
DELFLG(DA) ;EP - DELETE SESSION 'TRANSMITTED DATE' FLAG
;
K DIR,DIE,DR,DIC
S DR="602///@"
S DIE="^BARTR(DUZ(2),"
D ^DIE
Q
; ********************************************************************
;
CLEAR(UDUZ,SESSID) ;CLEAR FLAGS
N TRDATE,BARTMP,BAROK
S TRDATE=0
F S TRDATE=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE)) Q:'TRDATE D
.S BARTMP=$G(^BARTR(DUZ(2),TRDATE,6))
DIAG1 .W !,"@@@",TRDATE,"@",$P(BARTMP,U),"@",$P(BARTMP,U,2),"@",$P(BARTMP,U,3),"@",$P(BARTMP,U,4)
.D DELSFLG(UDUZ,SESSID,TRDATE)
.D DELFLG(TRDATE)
S BAROK=$$OPEN
I 'BAROK W " ",SESSID
Q
; ********************************************************************
;
OPEN() K DIC,DIE,DR,DA,DIR
S DA(1)=UDUZ
S X=SESSID
S DIC(0)="X"
S DIC="^BARSESS(DUZ(2),"_DA(1)_",11,"
D ^DIC
Q:Y<0 0
S X=$$SETSESS(UDUZ,$P(Y,U,2),"RV") Q:X=0 0 ;set this session to REVIEWED STATUS
Q SESSID
; ********************************************************************
;
FILE() ;
N FN,ANS,Z
K DIR
S DIR(0)="FO"
S DIR("?")="Enter a file name e.g. IHS_AR_RPMS_RCV_398_113510_20070806_0847.DAT,"
S DIR("A")="Enter exact filename "
D ^DIR
I $D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="")!(Y=" ") Q 0
S FN=Y
S Z="ARE YOU SURE YOU WANT TO CLEAR FLAGS FOR FILE "_FN
D ASK(Z,.ANS)
Q:'ANS 0
Q FN
; ********************************************************************
;
MSG(Z) ;MESSAGE CENTER
I Z=0 W !,"FIND CORRECT FILE NAME"
I Z=1 W !,"FILE NAME COULD NOT BE FOUND IN SESSION FILE"
I Z=2 W !,"NO SESSIONS FOR FILE NAME, UNABLE TO CLEAR FLAGS"
D EOP^BARUTL(1)
Q
; ********************************************************************
;
SETSESS(UDUZ,SESSID,BARSTAT) ;EP - SET SESSION STATUS 'BARSTAT'
Q:$G(BARSTAT)=""
S STATCHG=$$ADDSTAT^BARUFUT(UDUZ,SESSID) ;CREATE A NEW STATUS CHANGE DATE/TIME
I +STATCHG<1 D Q 0
.W !!,"UNABLE TO MAKE A CHANGE IN STATUS FOR SESSION ID ",SESSID
.K DIR
.S DIR(0)="E"
.D ^DIR
K DIC,DIE,DR,DA,DIR
S DA(2)=UDUZ
S DA(1)=SESSID
S DA=$P(STATCHG,U)
S DR=".02///^S X=BARSTAT;.03////^S X=DUZ"
S DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",1,"
D ^DIE
K DIC,DIE,DR,DA,DIR
I $G(MODE)="CASHIER" K UFMSESID
Q 1
; ********************************************************************
;
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
; ********************************************************************
;
ASK(Z,Y) ;
K DIR
S DIR(0)="YO"
S DIR("A")=Z
S DIR("B")="NO"
D ^DIR
Q
BARUFUTZ ; IHS/SD/TPF - UTILITY TO CLEAR TRANSMITTED FLAGS ; 12/12/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**10**;OCT 26, 2005
+2 ;NEW ROUTINE ;MRS:BAR*1.8*10 D148-2
+3 QUIT
+4 ;
EN ;EP; CLEAR TRANSMITTED FLAGS TO ALLOW RE-TRANSMISSION
+1 ; ********************************************************************
+2 KILL BAR
+3 NEW BARFILE,UDUZ,BARID,BARN
+4 ;GET FILE NAME
SET BARFILE=$$FILE
+5 IF BARFILE=0
DO MSG(0)
QUIT
+6 ;
+7 ;BUILD ARRAY OF SESSIONS
DO SESS(BARFILE)
+8 IF '$DATA(BAR)
DO MSG(2)
QUIT
+9 ;
+10 SET UDUZ=0
+11 FOR
SET UDUZ=$ORDER(BAR(UDUZ))
IF 'UDUZ
QUIT
Begin DoDot:1
+12 SET BARID=0
+13 FOR
SET BARID=$ORDER(BAR(UDUZ,BARID))
IF BARID=""
QUIT
Begin DoDot:2
DIAG WRITE !,UDUZ,"@",BARID,"@"
+1 SET BARN=0
+2 FOR
SET BARN=$ORDER(BAR(UDUZ,BARID,BARN))
IF 'BARN
QUIT
Begin DoDot:3
+3 SET BARFNM=BAR(UDUZ,BARID,BARN)
+4 WRITE BARFNM
+5 ;CLEAR FLAGS
DO CLEAR(UDUZ,BARID)
+6 ;CLEAR "FN" CROSS-REFERENCE
KILL ^BARSESS(DUZ(2),"FN",BARFNM,BARID,UDUZ,BARN)
End DoDot:3
End DoDot:2
End DoDot:1
+7 WRITE !,"SESSIONS CLEARED "
+8 DO EOP^BARUTL(1)
+9 QUIT
+10 ;
SESS(BARFILE) ;FIND UDUZ AND SESSIONS IN FILE
+1 ;Example of FN cross-reference
+2 ;^BARSESS(1575,"FN","835_232101_20081031_122246",3081031.122134,835,1)
+3 NEW BARFN,BARID,BARZ,BARN
+4 IF '$DATA(^BARSESS(DUZ(2),"FN"))
DO MSG(1)
QUIT
+5 ;ABREVIATED FILE NAME
SET BARFN=0
+6 FOR
SET BARFN=$ORDER(^BARSESS(DUZ(2),"FN",BARFN))
IF 'BARFN
QUIT
Begin DoDot:1
+7 ;NOT CORRECT FILE
IF BARFILE'[BARFN
QUIT
+8 ;SESSION ID
SET BARID=0
+9 FOR
SET BARID=$ORDER(^BARSESS(DUZ(2),"FN",BARFN,BARID))
IF BARID=""
QUIT
Begin DoDot:2
+10 ;UDUZ OF CASHIER
SET BARZ=0
+11 FOR
SET BARZ=$ORDER(^BARSESS(DUZ(2),"FN",BARFN,BARID,BARZ))
IF 'BARZ
QUIT
Begin DoDot:3
+12 ;MULTIPLE IDEX
SET BARN=0
+13 FOR
SET BARN=$ORDER(^BARSESS(DUZ(2),"FN",BARFN,BARID,BARZ,BARN))
IF 'BARN
QUIT
Begin DoDot:4
+14 ;RE-ORDER
SET BAR(BARZ,BARID,BARN)=BARFN
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ; ********************************************************************
+17 ;
DELSFLG(UDUZ,SESSID,DA) ;EP - DELETE SESSION 'TRANSMITTED DATE' FLAG
+1 ;
+2 KILL DIR,DIE,DR,DIC
+3 SET DA(2)=UDUZ
+4 SET DA(1)=SESSID
+5 SET DR=".04///@"
+6 SET DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
+7 DO ^DIE
+8 QUIT
+9 ; ********************************************************************
+10 ;
DELFLG(DA) ;EP - DELETE SESSION 'TRANSMITTED DATE' FLAG
+1 ;
+2 KILL DIR,DIE,DR,DIC
+3 SET DR="602///@"
+4 SET DIE="^BARTR(DUZ(2),"
+5 DO ^DIE
+6 QUIT
+7 ; ********************************************************************
+8 ;
CLEAR(UDUZ,SESSID) ;CLEAR FLAGS
+1 NEW TRDATE,BARTMP,BAROK
+2 SET TRDATE=0
+3 FOR
SET TRDATE=$ORDER(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE))
IF 'TRDATE
QUIT
Begin DoDot:1
+4 SET BARTMP=$GET(^BARTR(DUZ(2),TRDATE,6))
DIAG1 WRITE !,"@@@",TRDATE,"@",$PIECE(BARTMP,U),"@",$PIECE(BARTMP,U,2),"@",$PIECE(BARTMP,U,3),"@",$PIECE(BARTMP,U,4)
+1 DO DELSFLG(UDUZ,SESSID,TRDATE)
+2 DO DELFLG(TRDATE)
End DoDot:1
+3 SET BAROK=$$OPEN
+4 IF 'BAROK
WRITE " ",SESSID
+5 QUIT
+6 ; ********************************************************************
+7 ;
OPEN() KILL DIC,DIE,DR,DA,DIR
+1 SET DA(1)=UDUZ
+2 SET X=SESSID
+3 SET DIC(0)="X"
+4 SET DIC="^BARSESS(DUZ(2),"_DA(1)_",11,"
+5 DO ^DIC
+6 IF Y<0
QUIT 0
+7 ;set this session to REVIEWED STATUS
SET X=$$SETSESS(UDUZ,$PIECE(Y,U,2),"RV")
IF X=0
QUIT 0
+8 QUIT SESSID
+9 ; ********************************************************************
+10 ;
FILE() ;
+1 NEW FN,ANS,Z
+2 KILL DIR
+3 SET DIR(0)="FO"
+4 SET DIR("?")="Enter a file name e.g. IHS_AR_RPMS_RCV_398_113510_20070806_0847.DAT,"
+5 SET DIR("A")="Enter exact filename "
+6 DO ^DIR
+7 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")!(Y=" ")
QUIT 0
+8 SET FN=Y
+9 SET Z="ARE YOU SURE YOU WANT TO CLEAR FLAGS FOR FILE "_FN
+10 DO ASK(Z,.ANS)
+11 IF 'ANS
QUIT 0
+12 QUIT FN
+13 ; ********************************************************************
+14 ;
MSG(Z) ;MESSAGE CENTER
+1 IF Z=0
WRITE !,"FIND CORRECT FILE NAME"
+2 IF Z=1
WRITE !,"FILE NAME COULD NOT BE FOUND IN SESSION FILE"
+3 IF Z=2
WRITE !,"NO SESSIONS FOR FILE NAME, UNABLE TO CLEAR FLAGS"
+4 DO EOP^BARUTL(1)
+5 QUIT
+6 ; ********************************************************************
+7 ;
SETSESS(UDUZ,SESSID,BARSTAT) ;EP - SET SESSION STATUS 'BARSTAT'
+1 IF $GET(BARSTAT)=""
QUIT
+2 ;CREATE A NEW STATUS CHANGE DATE/TIME
SET STATCHG=$$ADDSTAT^BARUFUT(UDUZ,SESSID)
+3 IF +STATCHG<1
Begin DoDot:1
+4 WRITE !!,"UNABLE TO MAKE A CHANGE IN STATUS FOR SESSION ID ",SESSID
+5 KILL DIR
+6 SET DIR(0)="E"
+7 DO ^DIR
End DoDot:1
QUIT 0
+8 KILL DIC,DIE,DR,DA,DIR
+9 SET DA(2)=UDUZ
+10 SET DA(1)=SESSID
+11 SET DA=$PIECE(STATCHG,U)
+12 SET DR=".02///^S X=BARSTAT;.03////^S X=DUZ"
+13 SET DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",1,"
+14 DO ^DIE
+15 KILL DIC,DIE,DR,DA,DIR
+16 IF $GET(MODE)="CASHIER"
KILL UFMSESID
+17 QUIT 1
+18 ; ********************************************************************
+19 ;
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 ; ********************************************************************
+13 ;
ASK(Z,Y) ;
+1 KILL DIR
+2 SET DIR(0)="YO"
+3 SET DIR("A")=Z
+4 SET DIR("B")="NO"
+5 DO ^DIR
+6 QUIT
