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

PSXRACT.m

Go to the documentation of this file.
  1. PSXRACT ;BIR/HW-ACTIVITY REPORT [ 05/10/97 2:28 PM ] ; 31 Oct 2000 2:28 PM
  1. ;;2.0;CMOP;**1,31**;11 Apr 97
  1. ; External reference to ^PSRX( supported by DBIA #1221
  1. ; External reference to ^PS(59 supported by DBIA #1976
  1. ;
  1. BEGDATE S DIR(0)="DO",DIR("A")="ENTER BEGINNING TRANSMISSION DATE " D ^DIR K DIR
  1. G:$D(DIRUT)!(X']"") END
  1. S PSXB=Y K Y,X
  1. I PSXB>DT W !!,"Future dates are not allowed.",! G BEGDATE
  1. ENDDATE S Y=DT X ^DD("DD") S ZZTODAY=Y K Y
  1. K X,Y
  1. S DIR(0)="DO",DIR("A")="ENTER ENDING TRANSMISSION DATE ",DIR("B")=ZZTODAY
  1. D ^DIR K DIR
  1. G:$D(DIRUT) END
  1. S PSXE=Y K Y
  1. I PSXE<PSXB W !,"Ending date must follow beginning date!" G ENDDATE
  1. K ZZTODAY
  1. D SEL Q:'$D(DIVNM)
  1. DEVICE W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
  1. D ^%ZIS G:POP END S PSXLAP=ION
  1. I $E(IOST,1,2)["C-" G START
  1. I '$D(IO("Q")) G ST0
  1. D ^%ZISC K J,C
  1. QUE S ZTSAVE("PSXB")="",ZTSAVE("PSXE")="",ZTSAVE("DIVNM(")="",ZTSAVE("DIVDA(")="",ZTIO=PSXLAP
  1. S ZTRTN="START^PSXRACT"
  1. S ZTDESC="CMOP Activity Report"
  1. D ^%ZTLOAD
  1. Q1 W:$D(ZTSK) !!,"Report Queued to Print!!"
  1. K DIR,PSXB,PSXE,Y
  1. Q
  1. ST0 U IO
  1. ;Called by taskman to print the CMOP Activity Report
  1. START S:$D(ZTQUEUED) ZTREQ="@"
  1. S LINE="W ! F I=1:1:80 W ""="""
  1. DIVISION ;
  1. S DIVDA=0 F S DIVDA=$O(DIVDA(DIVDA)) Q:DIVDA'>0 D ONEDIV
  1. D GRNDSUM
  1. G EXIT
  1. ;
  1. Q
  1. ONEDIV ;
  1. S LINE="W ! F I=1:1:80 W ""=""",CT=0
  1. S Y=PSXB X ^DD("DD") S PSXBE=Y
  1. S Y=PSXE X ^DD("DD") S PSXEE=Y
  1. S PSXE1=PSXE+.99999,PSXD=PSXB-.00001
  1. D TITLE
  1. BATCH F S PSXD=$O(^PSX(550.2,"D",PSXD)) Q:(+PSXD'>0)!(+PSXD>PSXE1) D Q:$G(PSXFLAG)=1
  1. .F P5502=0:0 S P5502=$O(^PSX(550.2,"D",PSXD,P5502)) Q:'P5502 D Q:$G(PSXFLAG)=1
  1. ..S BATCH=+$P($G(^PSX(550.2,P5502,0)),"^") Q:$G(BATCH)']""
  1. ..S DIV=$P($G(^PSX(550.2,P5502,0)),"^",3),DIV=$P($G(^PS(59,DIV,0)),"^")
  1. ..I '$D(DIVNM(DIV)) Q
  1. ..I DIV'=DIVDA(DIVDA) Q
  1. ..S NODE=$G(^PSX(550.2,P5502,1)) Q:$G(NODE)']""
  1. ..S ORDS=$P($G(NODE),"^",7),TORDS=$G(TORDS)+ORDS,RTRN=$P(NODE,"^",2)
  1. ..S TORDS(DIV)=$G(TORDS(DIV))+ORDS
  1. ..S RXS=$P($G(NODE),"^",8),TRXS=$G(TRXS)+RXS
  1. ..S TRXS(DIV)=$G(TRXS(DIV))+RXS
  1. ..F PSXR=0:0 S PSXR=$O(^PSRX("AS",PSXD,PSXR)) Q:'PSXR D
  1. ...S PSXF="" F S PSXF=$O(^PSRX("AS",PSXD,PSXR,PSXF)) Q:($G(PSXF)']"") D RX
  1. ..D PRINT Q:$G(PSXFLAG)=1
  1. X LINE
  1. S DIV=DIVDA(DIVDA)
  1. W !,?9,DIV,?35,$J($G(TORDS(DIV)),7),?43,$J($G(TRXS(DIV)),6),?53,$J($G(PSXCRT(DIV)),7),?63,$J($G(PSXNDT(DIV)),7),?73,$J($G(PSXCUT(DIV)),5)
  1. Q
  1. GRNDSUM ;
  1. S DIVDA(0)=" Grand Total Summary",DIVDA=0
  1. D TITLE
  1. S DIV=0 F S DIV=$O(TORDS(DIV)) Q:DIV="" D
  1. .W !,?9,DIV,?35,$J($G(TORDS(DIV)),7),?43,$J($G(TRXS(DIV)),6),?53,$J($G(PSXCRT(DIV)),7),?63,$J($G(PSXNDT(DIV)),7),?73,$J($G(PSXCUT(DIV)),5)
  1. X LINE
  1. W !!,"TOTAL",?35,$J($G(TORDS),7),?43,$J($G(TRXS),6),?53,$J($G(PSXCRT),7),?63,$J($G(PSXNDT),7),?73,$J($G(PSXCUT),5)
  1. END K DIR,DIRUT,PSXB,PSXE,ZZTODAY,PSXLAP,PSXE1,PSXOT,PSXD,P5502,BATCH
  1. K DIV,NODE,TORDS,TRXS,PSXR,PSXF,GT,PSXFLAG,ZNODE,ZFILL,PSXSTAT,PSXCR
  1. K PSX,PSXCRT,PSXCUT,PSXLINE,PSXNDT,PSXNOW,X,Y,%,RTRN
  1. Q
  1. EXIT ;
  1. D END
  1. K DIVDA,DIVNM,PSXB,PSXE,LINE,CT,I,PSXBE,PSXEE,ZZTOT,ZTSK
  1. D ^%ZISC
  1. Q
  1. RX ; COUNT RX DATA
  1. I $D(^PSRX(PSXR,4,0)) F PSX=0:0 S PSX=$O(^PSRX(PSXR,4,PSX)) Q:'PSX D
  1. .S ZNODE=$G(^PSRX(PSXR,4,PSX,0)),ZFILL=$P($G(ZNODE),"^",3)
  1. .I $G(ZFILL)'=PSXF K ZFILL Q
  1. .I +$G(ZNODE)'=BATCH Q
  1. .S PSXSTAT=$P($G(ZNODE),"^",4),PSX(ZFILL)=PSXSTAT
  1. .K ZNODE,ZFILL,PSXSTAT
  1. I $G(PSX(PSXF))=1 S PSXCR=$G(PSXCR)+1,PSXCRT=$G(PSXCRT)+1 D Q
  1. .S PSXCRT(DIV)=$G(PSXCRT(DIV))+1
  1. I $G(PSX(PSXF))=3 S PSXND=$G(PSXND)+1,PSXNDT=$G(PSXNDT)+1 D Q
  1. .S PSXNDT(DIV)=$G(PSXNDT(DIV))+1
  1. I $G(PSX(PSXF))=2 S PSXRT=$G(PSXRT)+1 S:(RTRN)>0 COM="FILLED IN "_$G(RTRN)
  1. S PSXCU=$G(PSXCU)+1,PSXCUT=$G(PSXCUT)+1
  1. S PSXCUT(DIV)=$G(PSXCUT(DIV))+1
  1. S:$G(COM)'="" PSXCU=""
  1. Q
  1. TITLE I IOST["C-" W @IOF
  1. S Y=PSXB X ^DD("DD") S PSXBP=Y
  1. S Y=PSXE X ^DD("DD") S PSXEP=Y
  1. D NOW^%DTC S Y=% X ^DD("DD") S PSXNOW=Y
  1. W !,?30,"CMOP ACTIVITY REPORT"_$S($G(ZZTOT)=1:" SUMMARY",1:"")
  1. W !,DIVDA(DIVDA)
  1. W !,"For ",PSXBP," thru ",$P(PSXEP,"@"),?40,"Printed: ",PSXNOW
  1. S PSXLINE=6
  1. K PSXBP,PSXEP
  1. X LINE
  1. AHEAD W !,"TRANS #",?9,"DIVISION",?37,"ORDERS",?45,"RXS",?53,"RELEASED",?63,"NOT DISP",?73,"UNREL"
  1. X LINE
  1. Q
  1. PRINT I IOST["C-",($G(PSXLINE)>20) D Q:$G(PSXFLAG)=1
  1. .S DIR(0)="E" D ^DIR K DIR I $G(Y)'=1 S PSXFLAG=1 K Y Q
  1. .D TITLE
  1. I IOST'["C-",($G(PSXLINE)>60) W @IOF D TITLE
  1. ;S:$G(COM)="" PSXCU=""
  1. W !,$J($G(BATCH),6),?9,$S($G(COM)'="":$E($G(DIV),1,10)_" "_$G(COM),1:$G(DIV)),?35,$J($G(ORDS),7),?43,$J($G(RXS),6),?53,$J($G(PSXCR),7),?63,$J($G(PSXND),7),?73,$J($G(PSXCU),5)
  1. S PSXLINE=$G(PSXLINE)+1
  1. K BATCH,DIV,ORDS,RXS,PSXCR,PSXND,PSXCU,PSXRT,COM,COM1
  1. Q
  1. SEL ;Select divisions
  1. ; returns arrays
  1. ; DIVNM("names of divisions")=selection number
  1. ; DIVDA("iens of divisions")=name of division
  1. ; for testing
  1. W !!,"SELECTION OF DIVISION(S)",!
  1. S DIV="" K DIVNM,DIVDA,DIVX
  1. F I=1:1 S DIV=$O(^PS(59,"B",DIV)) Q:DIV="" S DIVNM(I)=DIV,DIVNM(DIV)=I,DIVDA=$O(^PS(59,"B",DIV,0)),DIVNM(I,"I")=DIVDA
  1. S I=I-1
  1. K DIR S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
  1. D ^DIR K DIR G:Y="A" ALL
  1. G:Y="S" SELECT
  1. Q
  1. SELECT ;
  1. F C=1:1:I S DIR("A",C)=C_" "_DIVNM(C)
  1. S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
  1. D ^DIR
  1. I '+Y K DIVNM Q
  1. M DIVX=DIVNM K DIVNM
  1. F I=1:1 S X=$P(Y,",",I) Q:'X M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
  1. K DIVX,DIR
  1. ALL W !!,"You have selected:",! S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV W !,DIV,?5,DIVNM(DIV)
  1. S DIR(0)="Y",DIR("A")="Is this corrrect ? ",DIR("B")="YES" D ^DIR
  1. K DIR
  1. I Y D Q
  1. .K DIVDA
  1. .S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV S DA=DIVNM(DIV,"I"),DIVDA(DA)=DIVNM(DIV) K DIVNM(DIV)
  1. G SEL
  1. ;