143 lines
5.0 KiB
Mathematica
143 lines
5.0 KiB
Mathematica
PSXSUDCN ;BIR/HTW-Routine to Provide Report of Rx's Suspended for CMOP ; 31 Oct 2000 1:20 PM
|
|
;;2.0;CMOP;**31**;11 Apr 97
|
|
; External reference to ^PS(52.5 supported by DBIA #1222
|
|
; External reference to ^PS(59 supported by DBIA #1976
|
|
;
|
|
BEGDATE ;GET BEGIN DATE
|
|
K DIR
|
|
W !,"Rx's Suspended for CMOP",!
|
|
S DIR(0)="DO",DIR("A")="ENTER BEGINNING DATE " D ^DIR K DIR
|
|
G:($G(Y)="")!($D(DIRUT)) END1
|
|
S PSXB=Y
|
|
ENDDATE ;GET ENDING DATE
|
|
K DIR,X,Y
|
|
S Y=DT X ^DD("DD") S DIR("B")=Y
|
|
S DIR(0)="DO",DIR("A")="ENTER ENDING DATE" D ^DIR K DIR
|
|
I $G(Y)="" G BEGDATE
|
|
Q:$D(DTOUT) I $D(DUOUT) G BEGDATE
|
|
S PSXE=Y
|
|
I PSXE<PSXB W !,"Ending date must follow beginning date!" G ENDDATE
|
|
; select division(s)
|
|
D SEL
|
|
I '$D(DIVNM) D END1,EXIT Q
|
|
;
|
|
DEVICE W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
|
|
D ^%ZIS G:POP END1 S PSXLAP=ION
|
|
I IOST["C-" G EN1
|
|
I '$D(IO("Q")) G EN0
|
|
QUE S ZTSAVE("PSXB")="",ZTSAVE("PSXE")="",ZTSAVE("DIVDA(")="",ZTSAVE("DIVNM(")="",ZTIO=PSXLAP
|
|
S ZTRTN="EN1^PSXSUDCN"
|
|
S ZTDESC="CMOP Count of Suspended CMOP Rx's by Day"
|
|
D ^%ZTLOAD
|
|
Q1 W:$D(ZTSK) !!,"Report Queued to Print!! ",ZTSK,!
|
|
K DIR,PSXB,PSXE,Y D ^%ZISC
|
|
D EXIT
|
|
Q
|
|
EN0 U IO
|
|
;Called by Taskman to run CMOP Rx's by day report
|
|
EN1 ;
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
DIVISION ;
|
|
S DIV=0 F Q:$G(PSXFLAG)=1 S DIV=$O(DIVDA(DIV)) Q:DIV'>0 D ONEDIV
|
|
D GRNDSUM
|
|
G EXIT
|
|
;
|
|
ONEDIV ;
|
|
S LINE="W ! F I=1:1:80 W ""=""",CT=0
|
|
S Y=PSXB X ^DD("DD") S PSXBE=Y
|
|
S Y=PSXE X ^DD("DD") S PSXEE=Y
|
|
S (PSXQ,PSXL,PSXAX,PSXP,PSXTOT)=0
|
|
S PSXD=PSXB-.00001,PSXTE=PSXE+.99999
|
|
D HEADER S CT=8
|
|
F Q:$G(PSXFLAG)=1 S PSXD=$O(^PS(52.5,"C",PSXD)) Q:'PSXD!(PSXD>PSXTE) D 525,BODY Q:$G(ANS)="^"
|
|
G END
|
|
525 Q:$G(PSXFLAG)=1
|
|
F PSX525=0:0 Q:$G(PSXFLAG)=1 S PSX525=$O(^PS(52.5,"C",PSXD,PSX525)) Q:'PSX525 I $D(^PS(52.5,PSX525,0)) D
|
|
.S DIVRX=$P(^PS(52.5,PSX525,0),U,6) Q:DIVRX'=DIV
|
|
.S N=$P($G(^PS(52.5,PSX525,0)),"^",7) I N]"" D
|
|
..S:N="Q" PSXQ=PSXQ+1
|
|
..I N="L"!(N="X")!(N="R") S PSXAX=PSXAX+1
|
|
..S:N="P" PSXP=PSXP+1
|
|
..S PSXTOT=PSXTOT+1
|
|
Q
|
|
HEADER D NOW^%DTC S Y=% X ^DD("DD") S PSXNOW=Y
|
|
HDR1 I IOST["C-" W @IOF
|
|
W !,?20,"COUNT OF SUSPENDED CMOP RX's BY DAY"
|
|
W !,DIVDA(DIV)
|
|
W !,"FROM: "_PSXBE," TO: "_$P(PSXEE,"@")," PRINTED: ",PSXNOW
|
|
X LINE
|
|
H1 W !,"DATE",?14,"QUEUED",?29,"TRANSMITTED",?47,"PRINTED",?62,"TOTAL"
|
|
S A=15-($L($G(PSXQ))\2),B=35-($L($G(PSXAX))\2),C=49-($L($G(PSXP))\2),D=62-($L($G(PSXTOT))\2)
|
|
X LINE
|
|
Q
|
|
BODY ;
|
|
Q:$G(PSXFLAG)=1
|
|
I IOST["C-",(CT>20) D PAGE Q:$G(ANS)="^" W @IOF S CT=0 D HDR1 G B1
|
|
I $G(CT)>56 S CT=0 W @IOF D HEADER
|
|
B1 S Y=PSXD X ^DD("DD") S XDATE=$P(Y,","),CT=CT+1
|
|
W !,XDATE,?A,$J($G(PSXQ),5),?B,$J($G(PSXAX),5),?C,$J($G(PSXP),5),?D,$J($G(PSXTOT),5)
|
|
S PSXQGD=$G(PSXQGD)+PSXQ,PSXAXGD=$G(PSXAXGD)+PSXAX,PSXPGD=$G(PSXPGD)+PSXP,PSXTOTGD=$G(PSXTOTGD)+PSXTOT
|
|
S (PSXQ,PSXAX,PSXP,PSXTOT)=0 K XDATE
|
|
Q
|
|
PAGE Q:$G(PSXFLAG)=1
|
|
K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue or ""^"" to exit" D ^DIR S:$D(DTOUT)!($D(DUOUT)) (ANS)="^",PSXFLAG=1
|
|
Q
|
|
END Q:$G(PSXFLAG)=1
|
|
X LINE W !,"Division Total",?A,$J($G(PSXQGD),5),?B,$J($G(PSXAXGD),5),?C,$J($G(PSXPGD),5),?D,$J($G(PSXTOTGD),5)
|
|
F X="PSXQGD","PSXAXGD","PSXPGD","PSXTOTGD" S DIVTOT(DIV,X)=$G(@X)
|
|
I IOST["C-" D PAGE
|
|
I IOST'["C-" W @IOF
|
|
END1 K DIR,X,Y,%,PSXD,PSXF,PSXQ,PSXL,PSXP,PSXAX,PSXTOT,PSXUNREL
|
|
K PSXAD,PSXOT,PSXR,I,PSXZ,FILL,STAT,NODE,POP,PSXGO
|
|
K PSXLAP,PSXNOW,PSXYES,ZTDESC,ZTIO,ZTRTN,ZTSAVE,PSXMW,PSXM,PSXW
|
|
K A,B,D,E,PSXCR,PSXCU,PSXFILL,PSXSUSDT,PSXX,ZTSK
|
|
K N,PSX525,PSXMT,PSXWT,C,CT,DIRUT,DIROUT,DTOUT,DUOUT,J,ANS,PSXQGD,PSXAXGD,PSXPGD,PSXTOTGD
|
|
Q
|
|
EXIT ;
|
|
D ^%ZISC
|
|
K PSXB,PSXE,LINE,PSXBE,PSXEE,PSXTE,DIVNM,DIVDA,DIV,DIVRX,DIVTOT,PSXFLAG D END1
|
|
Q
|
|
SEL ;Select divisions
|
|
; returns arrays
|
|
; DIVNM("names of divisions")=selection number
|
|
; DIVDA("iens of divisions")=name of division
|
|
; for testing
|
|
W !!,"SELECTION OF DIVISION(S)",!
|
|
S DIV="" K DIVNM,DIVDA,DIVX
|
|
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
|
|
S I=I-1
|
|
K DIR S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
|
|
D ^DIR K DIR
|
|
G:Y="A" ALL
|
|
G:Y="S" SELECT
|
|
Q
|
|
SELECT ;
|
|
F C=1:1:I S DIR("A",C)=C_" "_DIVNM(C)
|
|
S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
|
|
D ^DIR
|
|
I '+Y K DIVNM Q
|
|
M DIVX=DIVNM K DIVNM
|
|
F I=1:1 S X=$P(Y,",",I) Q:'X M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
|
|
K DIVX,DIR
|
|
ALL W !!,"You have selected:",! S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV W !,DIV,?5,DIVNM(DIV)
|
|
S DIR(0)="Y",DIR("A")="Is this corrrect ? ",DIR("B")="YES" D ^DIR
|
|
K DIR
|
|
I Y D Q
|
|
.K DIVDA
|
|
.S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV S DA=DIVNM(DIV,"I"),DIVDA(DA)=DIVNM(DIV) K DIVNM(DIV)
|
|
G SEL
|
|
;
|
|
GRNDSUM ;
|
|
Q:$G(PSXFLAG)=1
|
|
S DIV=0,DIVDA(0)=" GRAND TOTAL SUMMARY"
|
|
D HEADER
|
|
K DIVTOT(0)
|
|
F S DIV=$O(DIVDA(DIV)) Q:DIV'>0 D
|
|
. W !,DIVDA(DIV)
|
|
. F X="PSXQGD","PSXAXGD","PSXPGD","PSXTOTGD" S @X=DIVTOT(DIV,X),DIVTOT(0,X)=$G(DIVTOT(0,X))+@X
|
|
. W !,?A,$J($G(PSXQGD),5),?B,$J($G(PSXAXGD),5),?C,$J($G(PSXPGD),5),?D,$J($G(PSXTOTGD),5)
|
|
F X="PSXQGD","PSXAXGD","PSXPGD","PSXTOTGD" S @X=DIVTOT(0,X)
|
|
X LINE
|
|
W !,"Grand Total",?A,$J($G(PSXQGD),5),?B,$J($G(PSXAXGD),5),?C,$J($G(PSXPGD),5),?D,$J($G(PSXTOTGD),5)
|
|
Q
|