[613] | 1 | PSXSUDCN ;BIR/HTW-Routine to Provide Report of Rx's Suspended for CMOP ; 31 Oct 2000 1:20 PM
|
---|
| 2 | ;;2.0;CMOP;**31**;11 Apr 97
|
---|
| 3 | ; External reference to ^PS(52.5 supported by DBIA #1222
|
---|
| 4 | ; External reference to ^PS(59 supported by DBIA #1976
|
---|
| 5 | ;
|
---|
| 6 | BEGDATE ;GET BEGIN DATE
|
---|
| 7 | K DIR
|
---|
| 8 | W !,"Rx's Suspended for CMOP",!
|
---|
| 9 | S DIR(0)="DO",DIR("A")="ENTER BEGINNING DATE " D ^DIR K DIR
|
---|
| 10 | G:($G(Y)="")!($D(DIRUT)) END1
|
---|
| 11 | S PSXB=Y
|
---|
| 12 | ENDDATE ;GET ENDING DATE
|
---|
| 13 | K DIR,X,Y
|
---|
| 14 | S Y=DT X ^DD("DD") S DIR("B")=Y
|
---|
| 15 | S DIR(0)="DO",DIR("A")="ENTER ENDING DATE" D ^DIR K DIR
|
---|
| 16 | I $G(Y)="" G BEGDATE
|
---|
| 17 | Q:$D(DTOUT) I $D(DUOUT) G BEGDATE
|
---|
| 18 | S PSXE=Y
|
---|
| 19 | I PSXE<PSXB W !,"Ending date must follow beginning date!" G ENDDATE
|
---|
| 20 | ; select division(s)
|
---|
| 21 | D SEL
|
---|
| 22 | I '$D(DIVNM) D END1,EXIT Q
|
---|
| 23 | ;
|
---|
| 24 | DEVICE W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
|
---|
| 25 | D ^%ZIS G:POP END1 S PSXLAP=ION
|
---|
| 26 | I IOST["C-" G EN1
|
---|
| 27 | I '$D(IO("Q")) G EN0
|
---|
| 28 | QUE S ZTSAVE("PSXB")="",ZTSAVE("PSXE")="",ZTSAVE("DIVDA(")="",ZTSAVE("DIVNM(")="",ZTIO=PSXLAP
|
---|
| 29 | S ZTRTN="EN1^PSXSUDCN"
|
---|
| 30 | S ZTDESC="CMOP Count of Suspended CMOP Rx's by Day"
|
---|
| 31 | D ^%ZTLOAD
|
---|
| 32 | Q1 W:$D(ZTSK) !!,"Report Queued to Print!! ",ZTSK,!
|
---|
| 33 | K DIR,PSXB,PSXE,Y D ^%ZISC
|
---|
| 34 | D EXIT
|
---|
| 35 | Q
|
---|
| 36 | EN0 U IO
|
---|
| 37 | ;Called by Taskman to run CMOP Rx's by day report
|
---|
| 38 | EN1 ;
|
---|
| 39 | S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 40 | DIVISION ;
|
---|
| 41 | S DIV=0 F Q:$G(PSXFLAG)=1 S DIV=$O(DIVDA(DIV)) Q:DIV'>0 D ONEDIV
|
---|
| 42 | D GRNDSUM
|
---|
| 43 | G EXIT
|
---|
| 44 | ;
|
---|
| 45 | ONEDIV ;
|
---|
| 46 | S LINE="W ! F I=1:1:80 W ""=""",CT=0
|
---|
| 47 | S Y=PSXB X ^DD("DD") S PSXBE=Y
|
---|
| 48 | S Y=PSXE X ^DD("DD") S PSXEE=Y
|
---|
| 49 | S (PSXQ,PSXL,PSXAX,PSXP,PSXTOT)=0
|
---|
| 50 | S PSXD=PSXB-.00001,PSXTE=PSXE+.99999
|
---|
| 51 | D HEADER S CT=8
|
---|
| 52 | F Q:$G(PSXFLAG)=1 S PSXD=$O(^PS(52.5,"C",PSXD)) Q:'PSXD!(PSXD>PSXTE) D 525,BODY Q:$G(ANS)="^"
|
---|
| 53 | G END
|
---|
| 54 | 525 Q:$G(PSXFLAG)=1
|
---|
| 55 | 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
|
---|
| 56 | .S DIVRX=$P(^PS(52.5,PSX525,0),U,6) Q:DIVRX'=DIV
|
---|
| 57 | .S N=$P($G(^PS(52.5,PSX525,0)),"^",7) I N]"" D
|
---|
| 58 | ..S:N="Q" PSXQ=PSXQ+1
|
---|
| 59 | ..I N="L"!(N="X")!(N="R") S PSXAX=PSXAX+1
|
---|
| 60 | ..S:N="P" PSXP=PSXP+1
|
---|
| 61 | ..S PSXTOT=PSXTOT+1
|
---|
| 62 | Q
|
---|
| 63 | HEADER D NOW^%DTC S Y=% X ^DD("DD") S PSXNOW=Y
|
---|
| 64 | HDR1 I IOST["C-" W @IOF
|
---|
| 65 | W !,?20,"COUNT OF SUSPENDED CMOP RX's BY DAY"
|
---|
| 66 | W !,DIVDA(DIV)
|
---|
| 67 | W !,"FROM: "_PSXBE," TO: "_$P(PSXEE,"@")," PRINTED: ",PSXNOW
|
---|
| 68 | X LINE
|
---|
| 69 | H1 W !,"DATE",?14,"QUEUED",?29,"TRANSMITTED",?47,"PRINTED",?62,"TOTAL"
|
---|
| 70 | 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)
|
---|
| 71 | X LINE
|
---|
| 72 | Q
|
---|
| 73 | BODY ;
|
---|
| 74 | Q:$G(PSXFLAG)=1
|
---|
| 75 | I IOST["C-",(CT>20) D PAGE Q:$G(ANS)="^" W @IOF S CT=0 D HDR1 G B1
|
---|
| 76 | I $G(CT)>56 S CT=0 W @IOF D HEADER
|
---|
| 77 | B1 S Y=PSXD X ^DD("DD") S XDATE=$P(Y,","),CT=CT+1
|
---|
| 78 | W !,XDATE,?A,$J($G(PSXQ),5),?B,$J($G(PSXAX),5),?C,$J($G(PSXP),5),?D,$J($G(PSXTOT),5)
|
---|
| 79 | S PSXQGD=$G(PSXQGD)+PSXQ,PSXAXGD=$G(PSXAXGD)+PSXAX,PSXPGD=$G(PSXPGD)+PSXP,PSXTOTGD=$G(PSXTOTGD)+PSXTOT
|
---|
| 80 | S (PSXQ,PSXAX,PSXP,PSXTOT)=0 K XDATE
|
---|
| 81 | Q
|
---|
| 82 | PAGE Q:$G(PSXFLAG)=1
|
---|
| 83 | 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
|
---|
| 84 | Q
|
---|
| 85 | END Q:$G(PSXFLAG)=1
|
---|
| 86 | 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)
|
---|
| 87 | F X="PSXQGD","PSXAXGD","PSXPGD","PSXTOTGD" S DIVTOT(DIV,X)=$G(@X)
|
---|
| 88 | I IOST["C-" D PAGE
|
---|
| 89 | I IOST'["C-" W @IOF
|
---|
| 90 | END1 K DIR,X,Y,%,PSXD,PSXF,PSXQ,PSXL,PSXP,PSXAX,PSXTOT,PSXUNREL
|
---|
| 91 | K PSXAD,PSXOT,PSXR,I,PSXZ,FILL,STAT,NODE,POP,PSXGO
|
---|
| 92 | K PSXLAP,PSXNOW,PSXYES,ZTDESC,ZTIO,ZTRTN,ZTSAVE,PSXMW,PSXM,PSXW
|
---|
| 93 | K A,B,D,E,PSXCR,PSXCU,PSXFILL,PSXSUSDT,PSXX,ZTSK
|
---|
| 94 | K N,PSX525,PSXMT,PSXWT,C,CT,DIRUT,DIROUT,DTOUT,DUOUT,J,ANS,PSXQGD,PSXAXGD,PSXPGD,PSXTOTGD
|
---|
| 95 | Q
|
---|
| 96 | EXIT ;
|
---|
| 97 | D ^%ZISC
|
---|
| 98 | K PSXB,PSXE,LINE,PSXBE,PSXEE,PSXTE,DIVNM,DIVDA,DIV,DIVRX,DIVTOT,PSXFLAG D END1
|
---|
| 99 | Q
|
---|
| 100 | SEL ;Select divisions
|
---|
| 101 | ; returns arrays
|
---|
| 102 | ; DIVNM("names of divisions")=selection number
|
---|
| 103 | ; DIVDA("iens of divisions")=name of division
|
---|
| 104 | ; for testing
|
---|
| 105 | W !!,"SELECTION OF DIVISION(S)",!
|
---|
| 106 | S DIV="" K DIVNM,DIVDA,DIVX
|
---|
| 107 | 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
|
---|
| 108 | S I=I-1
|
---|
| 109 | K DIR S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
|
---|
| 110 | D ^DIR K DIR
|
---|
| 111 | G:Y="A" ALL
|
---|
| 112 | G:Y="S" SELECT
|
---|
| 113 | Q
|
---|
| 114 | SELECT ;
|
---|
| 115 | F C=1:1:I S DIR("A",C)=C_" "_DIVNM(C)
|
---|
| 116 | S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
|
---|
| 117 | D ^DIR
|
---|
| 118 | I '+Y K DIVNM Q
|
---|
| 119 | M DIVX=DIVNM K DIVNM
|
---|
| 120 | F I=1:1 S X=$P(Y,",",I) Q:'X M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
|
---|
| 121 | K DIVX,DIR
|
---|
| 122 | ALL W !!,"You have selected:",! S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV W !,DIV,?5,DIVNM(DIV)
|
---|
| 123 | S DIR(0)="Y",DIR("A")="Is this corrrect ? ",DIR("B")="YES" D ^DIR
|
---|
| 124 | K DIR
|
---|
| 125 | I Y D Q
|
---|
| 126 | .K DIVDA
|
---|
| 127 | .S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV S DA=DIVNM(DIV,"I"),DIVDA(DA)=DIVNM(DIV) K DIVNM(DIV)
|
---|
| 128 | G SEL
|
---|
| 129 | ;
|
---|
| 130 | GRNDSUM ;
|
---|
| 131 | Q:$G(PSXFLAG)=1
|
---|
| 132 | S DIV=0,DIVDA(0)=" GRAND TOTAL SUMMARY"
|
---|
| 133 | D HEADER
|
---|
| 134 | K DIVTOT(0)
|
---|
| 135 | F S DIV=$O(DIVDA(DIV)) Q:DIV'>0 D
|
---|
| 136 | . W !,DIVDA(DIV)
|
---|
| 137 | . F X="PSXQGD","PSXAXGD","PSXPGD","PSXTOTGD" S @X=DIVTOT(DIV,X),DIVTOT(0,X)=$G(DIVTOT(0,X))+@X
|
---|
| 138 | . W !,?A,$J($G(PSXQGD),5),?B,$J($G(PSXAXGD),5),?C,$J($G(PSXPGD),5),?D,$J($G(PSXTOTGD),5)
|
---|
| 139 | F X="PSXQGD","PSXAXGD","PSXPGD","PSXTOTGD" S @X=DIVTOT(0,X)
|
---|
| 140 | X LINE
|
---|
| 141 | W !,"Grand Total",?A,$J($G(PSXQGD),5),?B,$J($G(PSXAXGD),5),?C,$J($G(PSXPGD),5),?D,$J($G(PSXTOTGD),5)
|
---|
| 142 | Q
|
---|