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

BARUFUT3.m

Go to the documentation of this file. 
  1. BARUFUT3 ; IHS/SD/TPF - UTILITY FOR DETERMINING MISSING RECORDS ON THE HUB ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**4**;OCT 26, 2005
  1.  ;NEW ROUTINE ;BAR*1.8*4
  1.  Q
  1.  ;
  1. ASKFROM ;EP - ASK FROM DATE
  1.  S BARJOB=$J
  1.  K %DT
  1.  S %DT="AET"
  1.  S %DT("A")="Enter beginning transmission date: "
  1.  W !
  1.  D ^%DT
  1.  Q:X=""!(X[U)
  1.  I Y<0 W !,"INVALID DATE. TRY AGAIN!" H 2 G ASKFROM
  1.  S BARFROM=Y
  1. ASKTO ;EP - ASK TO DATE
  1.  K %DT
  1.  S %DT="AET"
  1.  S %DT("A")="Enter ending transmission date: "
  1.  W !
  1.  D ^%DT
  1.  G:X=""!(X[U) ASKFROM
  1.  I Y<0 W !,"INVALID DATE. TRY AGAIN!" H 2 G ASKTO
  1.  S BARTO=Y
  1.  I BARTO<BARFROM W !!,"END DATE MUST BE GREATER THAN BEGINING DATE" H 2 G ASKFROM
  1.  ;
  1. ASKDEV ;EP - ASK DEVICE 
  1.  S %ZIS="MQ"
  1.  W !
  1.  D ^%ZIS
  1.  Q:POP
  1.  I $D(IO("Q")) D QUE Q
  1.  U IO
  1.  D PRINT
  1.  D ^%ZISC
  1.  Q
  1. QUE ; EP - QUE COUNT OF RECEIPTS TRANSMITTED REPORT
  1.  S ZTRTN="PRINT^BARUFUT3"
  1.  S ZTDESC="COUNT OF RECEIPTS TRANSMITTED IN A GIVEN DATE RANGE"
  1.  S ZTSAVE("BARJOB")=""
  1.  S ZTSAVE("BARTO")=""
  1.  S ZTSAVE("BARFROM")=""
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
  1.  E  W !!?5,"Report task #: ",$G(ZTSK)
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1. PRINT ;EP - COUNT OF RECEIPTS TRANSMITTED IN A GIVEN DATE RANGE
  1.  N TRANSDT,SESSID,DUZ2,CASHIER,BARTRAN,ROUTINE,EXFROM,EXTO
  1.  S ROUTINE=$P($T(+1)," ")
  1.  S Y=BARFROM X ^DD("DD") S EXFROM=Y
  1.  S Y=BARTO X ^DD("DD") S EXTO=Y
  1.  K ^XTMP(ROUTINE,$J)
  1.  S ^XTMP(ROUTINE,0)=DT
  1.  S BARTO=BARTO_".999999"
  1.  S DUZ2=0
  1.  F  S DUZ2=$O(^BARSESS(DUZ2)) Q:'DUZ2  D
  1.  .S TRANSDT=BARFROM-.000001
  1.  .F  S TRANSDT=$O(^BARSESS(DUZ2,"F",TRANSDT)) Q:'TRANSDT!(TRANSDT>BARTO)  D
  1.  ..S SORTDT=$P(TRANSDT,".")
  1.  ..S CASHIER=""
  1.  ..F  S CASHIER=$O(^BARSESS(DUZ2,"F",TRANSDT,CASHIER)) Q:'CASHIER  D
  1.  ...S SESSID=""
  1.  ...F  S SESSID=$O(^BARSESS(DUZ2,"F",TRANSDT,CASHIER,SESSID)) Q:'SESSID  D
  1.  ....S TRANSREC=""
  1.  ....F  S TRANSREC=$O(^BARSESS(DUZ2,"F",TRANSDT,CASHIER,SESSID,TRANSREC)) Q:'TRANSREC  D
  1.  .....S FILENAME=$$GET1^DIQ(90057.210101,TRANSREC_","_SESSID_","_CASHIER_",",.02)
  1.  .....S:FILENAME="" FILENAME="UNDEFINED"
  1.  .....D COUNTS(DUZ2,CASHIER,SESSID,SORTDT)     ;COUNT TOTAL FOR THE SESSIONS
  1.  .....D FILETOT(DUZ2,FILENAME,CASHIER,SORTDT)  ;COUNT TOTALS FOR EACH FILE TRANSMITTED
  1.  D DISPLAY
  1.  ;K ^XTMP(ROUTINE,$J)
  1.  Q
  1.  ;
  1. COUNTS(DUZ2,CASHIER,SESSID,SORTDT) ;EP - COUNT RECEIPTS FOR THE DAY
  1.  S ESC=0
  1.  S BARTRAN=0
  1.  F  S BARTRAN=$O(^BARSESS(DUZ2,CASHIER,11,SESSID,2,BARTRAN)) Q:'BARTRAN  D
  1.  .S ^XTMP(ROUTINE,BARJOB,DUZ2)=$G(^XTMP(ROUTINE,BARJOB,DUZ2))+1
  1.  .S ^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT)=$G(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT))+1
  1.  Q
  1.  ;
  1. FILETOT(DUZ2,FILENAME,CASHIER,SORTDT) ;EP - RECEIPT TOTALS FOR THIS FILE NAME
  1.  N SESSID,BARTRAN
  1.  I FILENAME="UNDEFINED" D  Q
  1.  .S ^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME)=0
  1.  S FILENAME=$P($P(FILENAME,"_",5,8),".")
  1.  S SESSID=0
  1.  F  S SESSID=$O(^BARSESS(DUZ2,"FN",FILENAME,SESSID)) Q:'SESSID  D
  1.  .S BARTRAN=0
  1.  .F  S BARTRAN=$O(^BARSESS(DUZ2,CASHIER,11,SESSID,2,BARTRAN)) Q:'BARTRAN  D
  1.  ..S ^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME)=$G(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME))+1
  1.  Q
  1.  ;
  1. DISPLAY ;EP - DISPLAY REPORT
  1.  I '$O(^XTMP(ROUTINE,BARJOB,"")) W !,"NO COUNTS FOR THIS DATE RANGE!!" H 2 Q
  1.  S $P(LINE,"-",81)=""
  1.  D NOW^%DTC
  1.  S Y=% X ^DD("DD") S NOW=Y
  1.  S NOW=Y
  1.  ;S FACILITY=$O(^XTMP(ROUTINE,BARJOB,""))
  1.  ;D HDR(NOW,FACILITY)
  1.  ;D DET
  1.  S DUZ2=""
  1.  F  S DUZ2=$O(^XTMP(ROUTINE,BARJOB,DUZ2)) Q:'DUZ2  D  Q:ESC
  1.  .D HDR(NOW,DUZ2),DET
  1.  .S CNT=0
  1.  .S SORTDT=""
  1.  .F  S SORTDT=$O(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT)) Q:SORTDT=""  D  Q:ESC
  1.  ..S FILENAME=""
  1.  ..F  S FILENAME=$O(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME)) Q:'FILENAME  D  Q:ESC
  1.  ...S CNT=CNT+1
  1.  ...I $Y>(IOSL-4),$D(ZTQUEUED) D HDR(NOW,DUZ2),DET
  1.  ...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
  1.  ...W !,CNT_". "
  1.  ...W FILENAME
  1.  ...S Y=SORTDT X ^DD("DD") S EXDATE=Y
  1.  ...W ?53,EXDATE
  1.  ...W ?68,$J(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT,FILENAME),5)
  1.  ...W ?76,"[ ]"
  1.  ..W !?66,"------"
  1.  ..W !?68,$J(^XTMP(ROUTINE,BARJOB,DUZ2,SORTDT),5)
  1.  ..W !,LINE
  1.  .Q:ESC
  1.  .W !,LINE
  1.  .W !?18,"GRAND TOTAL: ",$J($G(^XTMP(ROUTINE,BARJOB,DUZ2)),10)
  1.  .I IO=IO(0),'$D(IO("S")) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=$G(X)=U
  1.  Q
  1.  ;
  1. DET ;EP - DETAIL
  1.  W !,"FILE"
  1.  W ?56,"DATE"
  1.  W ?66,"RECEIPTS"
  1.  W ?77,"AT"
  1.  W !,"NAME"
  1.  W ?52,"TRANSMITTED"
  1.  W ?67,"TRANS"
  1.  W ?76,"HUB?"
  1.  W !,LINE
  1.  Q
  1.  ;
  1. HDR(DATE,FACILITY) ;EP - HEADER
  1.  W @IOF
  1.  W !,$$CJ^XLFSTR("COUNT OF RECEIPTS TRANSMITTED IN A GIVEN DATE RANGE",IOM)
  1.  W !,$$CJ^XLFSTR("REPORT DATE: "_DATE,IOM)
  1.  W !,$$CJ^XLFSTR("PRINTED BY : "_$$GET1^DIQ(200,DUZ_",",.01),IOM)
  1.  W !,$$CJ^XLFSTR("TRANSMISSIONS FROM "_EXFROM_" TO "_EXTO,IOM)
  1.  W !,$$CJ^XLFSTR("FOR FACILITY: "_$$GET1^DIQ(9999999.06,DUZ2_",",.01,"E"),IOM)
  1.  W !
  1.  Q