BARUFUT3 ; IHS/SD/TPF - UTILITY FOR DETERMINING MISSING RECORDS ON THE HUB ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**4**;OCT 26, 2005
;NEW ROUTINE ;BAR*1.8*4
Q
;
ASKFROM ;EP - ASK FROM DATE
S BARJOB=$J
K %DT
S %DT="AET"
S %DT("A")="Enter beginning transmission date: "
W !
D ^%DT
Q:X=""!(X[U)
I Y<0 W !,"INVALID DATE. TRY AGAIN!" H 2 G ASKFROM
S BARFROM=Y
ASKTO ;EP - ASK TO DATE
K %DT
S %DT="AET"
S %DT("A")="Enter ending transmission date: "
W !
D ^%DT
G:X=""!(X[U) ASKFROM
I Y<0 W !,"INVALID DATE. TRY AGAIN!" H 2 G ASKTO
S BARTO=Y
I BARTO<BARFROM W !!,"END DATE MUST BE GREATER THAN BEGINING DATE" H 2 G ASKFROM
;
ASKDEV ;EP - ASK DEVICE
S %ZIS="MQ"
W !
D ^%ZIS
Q:POP
I $D(IO("Q")) D QUE Q
U IO
D PRINT
D ^%ZISC
Q
QUE ; EP - QUE COUNT OF RECEIPTS TRANSMITTED REPORT
S ZTRTN="PRINT^BARUFUT3"
S ZTDESC="COUNT OF RECEIPTS TRANSMITTED IN A GIVEN DATE RANGE"
S ZTSAVE("BARJOB")=""
S ZTSAVE("BARTO")=""
S ZTSAVE("BARFROM")=""
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
E W !!?5,"Report task #: ",$G(ZTSK)
D HOME^%ZIS
Q
;
PRINT ;EP - COUNT OF RECEIPTS TRANSMITTED IN A GIVEN DATE RANGE
N TRANSDT,SESSID,DUZ2,CASHIER,BARTRAN,ROUTINE,EXFROM,EXTO
S ROUTINE=$P($T(+1)," ")
S Y=BARFROM X ^DD("DD") S EXFROM=Y
S Y=BARTO X ^DD("DD") S EXTO=Y
K ^XTMP(ROUTINE,$J)
S ^XTMP(ROUTINE,0)=DT
S BARTO=BARTO_".999999"
S DUZ2=0
F S DUZ2=$O(^BARSESS(DUZ2)) Q:'DUZ2 D
.S TRANSDT=BARFROM-.000001
.F S TRANSDT=$O(^BARSESS(DUZ2,"F",TRANSDT)) Q:'TRANSDT!(TRANSDT>BARTO) D
..S SORTDT=$P(TRANSDT,".")
..S CASHIER=""
..F S CASHIER=$O(^BARSESS(DUZ2,"F",TRANSDT,CASHIER)) Q:'CASHIER D
...S SESSID=""
...F S SESSID=$O(^BARSESS(DUZ2,"F",TRANSDT,CASHIER,SESSID)) Q:'SESSID D
....S TRANSREC=""
....F S TRANSREC=$O(^BARSESS(DUZ2,"F",TRANSDT,CASHIER,SESSID,TRANSREC)) Q:'TRANSREC D
.....S FILENAME=$$GET1^DIQ(90057.210101,TRANSREC_","_SESSID_","_CASHIER_",",.02)
.....S:FILENAME="" FILENAME="UNDEFINED"
.....D COUNTS(DUZ2,CASHIER,SESSID,SORTDT) ;COUNT TOTAL FOR THE SESSIONS
.....D FILETOT(DUZ2,FILENAME,CASHIER,SORTDT) ;COUNT TOTALS FOR EACH FILE TRANSMITTED
D DISPLAY
;K ^XTMP(ROUTINE,$J)
Q
;
COUNTS(DUZ2,CASHIER,SESSID,SORTDT) ;EP - COUNT RECEIPTS FOR THE DAY
S ESC=0
S BARTRAN=0
F S BARTRAN=$O(^BARSESS(DUZ2,CASHIER,11,SESSID,2,BARTRAN)) Q:'BARTRAN D
.S ^XTMP(ROUTINE,BARJOB,DUZ2)=$G(^XTMP(ROUTINE,BARJOB,DUZ2))+1
.S ^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT)=$G(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT))+1
Q
;
FILETOT(DUZ2,FILENAME,CASHIER,SORTDT) ;EP - RECEIPT TOTALS FOR THIS FILE NAME
N SESSID,BARTRAN
I FILENAME="UNDEFINED" D Q
.S ^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME)=0
S FILENAME=$P($P(FILENAME,"_",5,8),".")
S SESSID=0
F S SESSID=$O(^BARSESS(DUZ2,"FN",FILENAME,SESSID)) Q:'SESSID D
.S BARTRAN=0
.F S BARTRAN=$O(^BARSESS(DUZ2,CASHIER,11,SESSID,2,BARTRAN)) Q:'BARTRAN D
..S ^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME)=$G(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME))+1
Q
;
DISPLAY ;EP - DISPLAY REPORT
I '$O(^XTMP(ROUTINE,BARJOB,"")) W !,"NO COUNTS FOR THIS DATE RANGE!!" H 2 Q
S $P(LINE,"-",81)=""
D NOW^%DTC
S Y=% X ^DD("DD") S NOW=Y
S NOW=Y
;S FACILITY=$O(^XTMP(ROUTINE,BARJOB,""))
;D HDR(NOW,FACILITY)
;D DET
S DUZ2=""
F S DUZ2=$O(^XTMP(ROUTINE,BARJOB,DUZ2)) Q:'DUZ2 D Q:ESC
.D HDR(NOW,DUZ2),DET
.S CNT=0
.S SORTDT=""
.F S SORTDT=$O(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT)) Q:SORTDT="" D Q:ESC
..S FILENAME=""
..F S FILENAME=$O(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME)) Q:'FILENAME D Q:ESC
...S CNT=CNT+1
...I $Y>(IOSL-4),$D(ZTQUEUED) D HDR(NOW,DUZ2),DET
...I $Y>(IOSL-4),(IO=IO(0)),'$D(IO("S")) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=$G(X)=U Q:ESC D HDR(NOW,DUZ2),DET
...W !,CNT_". "
...W FILENAME
...S Y=SORTDT X ^DD("DD") S EXDATE=Y
...W ?53,EXDATE
...W ?68,$J(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME),5)
...W ?76,"[ ]"
..W !?66,"------"
..W !?68,$J(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT),5)
..W !,LINE
.Q:ESC
.W !,LINE
.W !?18,"GRAND TOTAL: ",$J($G(^XTMP(ROUTINE,BARJOB,DUZ2)),10)
.I IO=IO(0),'$D(IO("S")) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=$G(X)=U
Q
;
DET ;EP - DETAIL
W !,"FILE"
W ?56,"DATE"
W ?66,"RECEIPTS"
W ?77,"AT"
W !,"NAME"
W ?52,"TRANSMITTED"
W ?67,"TRANS"
W ?76,"HUB?"
W !,LINE
Q
;
HDR(DATE,FACILITY) ;EP - HEADER
W @IOF
W !,$$CJ^XLFSTR("COUNT OF RECEIPTS TRANSMITTED IN A GIVEN DATE RANGE",IOM)
W !,$$CJ^XLFSTR("REPORT DATE: "_DATE,IOM)
W !,$$CJ^XLFSTR("PRINTED BY : "_$$GET1^DIQ(200,DUZ_",",.01),IOM)
W !,$$CJ^XLFSTR("TRANSMISSIONS FROM "_EXFROM_" TO "_EXTO,IOM)
W !,$$CJ^XLFSTR("FOR FACILITY: "_$$GET1^DIQ(9999999.06,DUZ2_",",.01,"E"),IOM)
W !
Q
BARUFUT3 ; IHS/SD/TPF - UTILITY FOR DETERMINING MISSING RECORDS ON THE HUB ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4**;OCT 26, 2005
+2 ;NEW ROUTINE ;BAR*1.8*4
+3 QUIT
+4 ;
ASKFROM ;EP - ASK FROM DATE
+1 SET BARJOB=$JOB
+2 KILL %DT
+3 SET %DT="AET"
+4 SET %DT("A")="Enter beginning transmission date: "
+5 WRITE !
+6 DO ^%DT
+7 IF X=""!(X[U)
QUIT
+8 IF Y<0
WRITE !,"INVALID DATE. TRY AGAIN!"
HANG 2
GOTO ASKFROM
+9 SET BARFROM=Y
ASKTO ;EP - ASK TO DATE
+1 KILL %DT
+2 SET %DT="AET"
+3 SET %DT("A")="Enter ending transmission date: "
+4 WRITE !
+5 DO ^%DT
+6 IF X=""!(X[U)
GOTO ASKFROM
+7 IF Y<0
WRITE !,"INVALID DATE. TRY AGAIN!"
HANG 2
GOTO ASKTO
+8 SET BARTO=Y
+9 IF BARTO<BARFROM
WRITE !!,"END DATE MUST BE GREATER THAN BEGINING DATE"
HANG 2
GOTO ASKFROM
+10 ;
ASKDEV ;EP - ASK DEVICE
+1 SET %ZIS="MQ"
+2 WRITE !
+3 DO ^%ZIS
+4 IF POP
QUIT
+5 IF $DATA(IO("Q"))
DO QUE
QUIT
+6 USE IO
+7 DO PRINT
+8 DO ^%ZISC
+9 QUIT
QUE ; EP - QUE COUNT OF RECEIPTS TRANSMITTED REPORT
+1 SET ZTRTN="PRINT^BARUFUT3"
+2 SET ZTDESC="COUNT OF RECEIPTS TRANSMITTED IN A GIVEN DATE RANGE"
+3 SET ZTSAVE("BARJOB")=""
+4 SET ZTSAVE("BARTO")=""
+5 SET ZTSAVE("BARFROM")=""
+6 DO ^%ZTLOAD
+7 IF $DATA(ZTSK)[0
WRITE !!?5,"Report Cancelled!"
+8 IF '$TEST
WRITE !!?5,"Report task #: ",$GET(ZTSK)
+9 DO HOME^%ZIS
+10 QUIT
+11 ;
PRINT ;EP - COUNT OF RECEIPTS TRANSMITTED IN A GIVEN DATE RANGE
+1 NEW TRANSDT,SESSID,DUZ2,CASHIER,BARTRAN,ROUTINE,EXFROM,EXTO
+2 SET ROUTINE=$PIECE($TEXT(+1)," ")
+3 SET Y=BARFROM
XECUTE ^DD("DD")
SET EXFROM=Y
+4 SET Y=BARTO
XECUTE ^DD("DD")
SET EXTO=Y
+5 KILL ^XTMP(ROUTINE,$JOB)
+6 SET ^XTMP(ROUTINE,0)=DT
+7 SET BARTO=BARTO_".999999"
+8 SET DUZ2=0
+9 FOR
SET DUZ2=$ORDER(^BARSESS(DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+10 SET TRANSDT=BARFROM-.000001
+11 FOR
SET TRANSDT=$ORDER(^BARSESS(DUZ2,"F",TRANSDT))
IF 'TRANSDT!(TRANSDT>BARTO)
QUIT
Begin DoDot:2
+12 SET SORTDT=$PIECE(TRANSDT,".")
+13 SET CASHIER=""
+14 FOR
SET CASHIER=$ORDER(^BARSESS(DUZ2,"F",TRANSDT,CASHIER))
IF 'CASHIER
QUIT
Begin DoDot:3
+15 SET SESSID=""
+16 FOR
SET SESSID=$ORDER(^BARSESS(DUZ2,"F",TRANSDT,CASHIER,SESSID))
IF 'SESSID
QUIT
Begin DoDot:4
+17 SET TRANSREC=""
+18 FOR
SET TRANSREC=$ORDER(^BARSESS(DUZ2,"F",TRANSDT,CASHIER,SESSID,TRANSREC))
IF 'TRANSREC
QUIT
Begin DoDot:5
+19 SET FILENAME=$$GET1^DIQ(90057.210101,TRANSREC_","_SESSID_","_CASHIER_",",.02)
+20 IF FILENAME=""
SET FILENAME="UNDEFINED"
+21 ;COUNT TOTAL FOR THE SESSIONS
DO COUNTS(DUZ2,CASHIER,SESSID,SORTDT)
+22 ;COUNT TOTALS FOR EACH FILE TRANSMITTED
DO FILETOT(DUZ2,FILENAME,CASHIER,SORTDT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 DO DISPLAY
+24 ;K ^XTMP(ROUTINE,$J)
+25 QUIT
+26 ;
COUNTS(DUZ2,CASHIER,SESSID,SORTDT) ;EP - COUNT RECEIPTS FOR THE DAY
+1 SET ESC=0
+2 SET BARTRAN=0
+3 FOR
SET BARTRAN=$ORDER(^BARSESS(DUZ2,CASHIER,11,SESSID,2,BARTRAN))
IF 'BARTRAN
QUIT
Begin DoDot:1
+4 SET ^XTMP(ROUTINE,BARJOB,DUZ2)=$GET(^XTMP(ROUTINE,BARJOB,DUZ2))+1
+5 SET ^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT)=$GET(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT))+1
End DoDot:1
+6 QUIT
+7 ;
FILETOT(DUZ2,FILENAME,CASHIER,SORTDT) ;EP - RECEIPT TOTALS FOR THIS FILE NAME
+1 NEW SESSID,BARTRAN
+2 IF FILENAME="UNDEFINED"
Begin DoDot:1
+3 SET ^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME)=0
End DoDot:1
QUIT
+4 SET FILENAME=$PIECE($PIECE(FILENAME,"_",5,8),".")
+5 SET SESSID=0
+6 FOR
SET SESSID=$ORDER(^BARSESS(DUZ2,"FN",FILENAME,SESSID))
IF 'SESSID
QUIT
Begin DoDot:1
+7 SET BARTRAN=0
+8 FOR
SET BARTRAN=$ORDER(^BARSESS(DUZ2,CASHIER,11,SESSID,2,BARTRAN))
IF 'BARTRAN
QUIT
Begin DoDot:2
+9 SET ^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME)=$GET(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME))+1
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
DISPLAY ;EP - DISPLAY REPORT
+1 IF '$ORDER(^XTMP(ROUTINE,BARJOB,""))
WRITE !,"NO COUNTS FOR THIS DATE RANGE!!"
HANG 2
QUIT
+2 SET $PIECE(LINE,"-",81)=""
+3 DO NOW^%DTC
+4 SET Y=%
XECUTE ^DD("DD")
SET NOW=Y
+5 SET NOW=Y
+6 ;S FACILITY=$O(^XTMP(ROUTINE,BARJOB,""))
+7 ;D HDR(NOW,FACILITY)
+8 ;D DET
+9 SET DUZ2=""
+10 FOR
SET DUZ2=$ORDER(^XTMP(ROUTINE,BARJOB,DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:1
+11 DO HDR(NOW,DUZ2)
DO DET
+12 SET CNT=0
+13 SET SORTDT=""
+14 FOR
SET SORTDT=$ORDER(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT))
IF SORTDT=""
QUIT
Begin DoDot:2
+15 SET FILENAME=""
+16 FOR
SET FILENAME=$ORDER(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME))
IF 'FILENAME
QUIT
Begin DoDot:3
+17 SET CNT=CNT+1
+18 IF $Y>(IOSL-4)
IF $DATA(ZTQUEUED)
DO HDR(NOW,DUZ2)
DO DET
+19 IF $Y>(IOSL-4)
IF (IO=IO(0))
IF '$DATA(IO("S"))
KILL DIR
SET DIR(0)="E"
IF '$DATA(ZTQUEUED)
DO ^DIR
SET ESC=$GET(X)=U
IF ESC
QUIT
DO HDR(NOW,DUZ2)
DO DET
+20 WRITE !,CNT_". "
+21 WRITE FILENAME
+22 SET Y=SORTDT
XECUTE ^DD("DD")
SET EXDATE=Y
+23 WRITE ?53,EXDATE
+24 WRITE ?68,$JUSTIFY(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME),5)
+25 WRITE ?76,"[ ]"
End DoDot:3
IF ESC
QUIT
+26 WRITE !?66,"------"
+27 WRITE !?68,$JUSTIFY(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT),5)
+28 WRITE !,LINE
End DoDot:2
IF ESC
QUIT
+29 IF ESC
QUIT
+30 WRITE !,LINE
+31 WRITE !?18,"GRAND TOTAL: ",$JUSTIFY($GET(^XTMP(ROUTINE,BARJOB,DUZ2)),10)
+32 IF IO=IO(0)
IF '$DATA(IO("S"))
KILL DIR
SET DIR(0)="E"
IF '$DATA(ZTQUEUED)
DO ^DIR
SET ESC=$GET(X)=U
End DoDot:1
IF ESC
QUIT
+33 QUIT
+34 ;
DET ;EP - DETAIL
+1 WRITE !,"FILE"
+2 WRITE ?56,"DATE"
+3 WRITE ?66,"RECEIPTS"
+4 WRITE ?77,"AT"
+5 WRITE !,"NAME"
+6 WRITE ?52,"TRANSMITTED"
+7 WRITE ?67,"TRANS"
+8 WRITE ?76,"HUB?"
+9 WRITE !,LINE
+10 QUIT
+11 ;
HDR(DATE,FACILITY) ;EP - HEADER
+1 WRITE @IOF
+2 WRITE !,$$CJ^XLFSTR("COUNT OF RECEIPTS TRANSMITTED IN A GIVEN DATE RANGE",IOM)
+3 WRITE !,$$CJ^XLFSTR("REPORT DATE: "_DATE,IOM)
+4 WRITE !,$$CJ^XLFSTR("PRINTED BY : "_$$GET1^DIQ(200,DUZ_",",.01),IOM)
+5 WRITE !,$$CJ^XLFSTR("TRANSMISSIONS FROM "_EXFROM_" TO "_EXTO,IOM)
+6 WRITE !,$$CJ^XLFSTR("FOR FACILITY: "_$$GET1^DIQ(9999999.06,DUZ2_",",.01,"E"),IOM)
+7 WRITE !
+8 QUIT
