84 lines
4.1 KiB
Mathematica
84 lines
4.1 KiB
Mathematica
PSXREJ ;BIR/BAB-Rejected Messages Report ;04/08/97 2:06 PM
|
|
;;2.0;CMOP;**38**;11 Apr 97
|
|
EN ;GET BEGIN DATE
|
|
S %DT="AEX",%DT("A")="ENTER BEGINNING DATE: ",%DT("B")="NOW",%DT(0)="-NOW" D ^%DT K %DT,%DT(0),%DT("A"),%DT("B") G:$G(Y)<0!($D(DTOUT)) EXIT
|
|
S PSXA=$P(Y,".",1),START=$$FMTE^XLFDT(Y,"1D")
|
|
ENDATE ;GET ENDING DATE
|
|
S %DT="AEX",%DT("A")="ENTER ENDING DATE: ",%DT("B")="NOW",%DT(0)="-NOW" D ^%DT K %DT,%DT(0),%DT("A"),%DT("B") G:$G(Y)<0!($D(DTOUT)) EXIT
|
|
S PSXE=$P(Y,".",1),FINISH=$$FMTE^XLFDT(Y,"1D")
|
|
K X,Y
|
|
I PSXE<PSXA W !,"Ending date must follow beginning date!" G ENDATE
|
|
S PSXA=PSXA-.00001,PSXE=PSXE+.99999
|
|
END S %ZIS="Q" D ^%ZIS S PSXLION=ION I POP W !,"No Device Selected" G EXIT
|
|
I $D(IO("Q")) D QUE G EXIT
|
|
D START,EXIT
|
|
Q
|
|
QUE ;
|
|
S ZTRTN="START^PSXREJ",ZTDESC="CMOP Rejected Messages Report"
|
|
S ZTSAVE("PSXB")="",ZTSAVE("PSXDA")=""
|
|
S ZTSAVE("PSXLION")="",ZTSAVE("PSXA")="",ZTSAVE("PSXE")=""
|
|
S ZTSAVE("START")="",ZTSAVE("FINISH")=""
|
|
S ZTIO=PSXLION D ^%ZTLOAD
|
|
I $D(ZTSK)[0 W !!,"Job Canceled"
|
|
E W !!,"Job Queued"
|
|
D HOME^%ZIS Q
|
|
;Called by Taskman to start the Rejected Messages Report
|
|
START ;
|
|
U IO
|
|
F S PSXA=$O(^PSX(552.1,"AP",PSXA)) Q:(PSXA']""!(PSXA>PSXE)) D
|
|
.S PSXB="" F S PSXB=$O(^PSX(552.1,"AP",PSXA,PSXB)) Q:($G(PSXB)']"") S PSXDA=$O(^PSX(552.1,"AP",PSXA,PSXB,0)) D REF
|
|
I '$G(PSXFLAG) W !!,"There were no rejected messages for the date range selected: ",START," to ",FINISH
|
|
G EXIT
|
|
REF ;
|
|
I '$D(^PSX(552.2,"AR",PSXB)) Q
|
|
Q:'$D(^PSX(552.1,PSXDA,0))
|
|
S SITEN=+$P(^PSX(552.1,PSXDA,0),U,1)
|
|
Q:$G(SITEN)']""
|
|
;S X=SITEN,DIC="4",DIC(0)="MOZX" S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S ST=+Y,SITE=$P(Y,"^",2),PHAR=$P(^PSX(552.1,PSXDA,"P"),U,1) ;****DOD L1
|
|
S X=SITEN,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S ST=$$IEN^XUMF(4,AGNCY,X),SITE=$$GET1^DIQ(4,ST,.01),PHAR=$P(^PSX(552.1,PSXDA,"P"),U,1) ;****DOD L1
|
|
S X=$P(^PSX(552.1,PSXDA,0),U,4),TDTM=$$FMTE^XLFDT(X,"1P")
|
|
S TOTRX=$P($G(^PSX(552.1,PSXDA,1)),U,4)
|
|
S TOTORD=$P($G(^PSX(552.1,PSXDA,1)),U,3)
|
|
;
|
|
;
|
|
S OR1=0
|
|
S (REC,CNT)=0 D SUB F S REC=$O(^PSX(552.2,"AR",PSXB,REC)) Q:REC'>0 D GETDATA
|
|
;G EXIT
|
|
Q
|
|
GETDATA ;
|
|
S ORDER=$P($G(^PSX(552.2,REC,0)),"^") S ZZ=0
|
|
K REASON S REASON=$P($P($G(^PSX(552.2,REC,"ACK")),"MSA|",2),"|",3)
|
|
F S ZZ=$O(^PSX(552.2,REC,"T",ZZ)) Q:ZZ'>0 S NODE=$G(^PSX(552.2,REC,"T",ZZ,0)) D
|
|
.Q:$E(NODE,1,4)["MSH|"!($E(NODE,1,4)["NTE|")
|
|
.I $E(NODE,1,4)["PID|" S NM=$P(NODE,"|",6),SS=$P($P(NODE,"|",4),"^",1),SSN=$E(SS,1,3)_"-"_$E(SS,4,5)_"-"_$E(SS,6,9),NAME=$P(NM,"^",1)_", "_$P(NM,"^",2)
|
|
.I $E(NODE,1,4)["ORC|" S ZX=ZZ F S ZX=$O(^PSX(552.2,REC,"T",ZX)) Q:ZX'>0 S TNODE=$G(^PSX(552.2,REC,"T",ZX,0)) D
|
|
..Q:$E(TNODE,1,4)["NTE|"
|
|
..I $E(TNODE,1,4)["ORC|" S ZZ=ZX Q
|
|
..I $E(TNODE,1,4)["RX1|" S DRUGNUM=$P($P(TNODE,"|",15),"^",1),DRUGNM=$P($P(TNODE,"|",15),"^",2),ISSDATE=$P(TNODE,"|",21),EXDATE=$P(TNODE,"|",25),RXNUM=$P(TNODE,"|",27),IDATE=$E(ISSDATE,5,6)_"/"_$E(ISSDATE,7,8)_"/"_$E(ISSDATE,3,4) D Q
|
|
...S EDATE=$E(EXDATE,5,6)_"/"_$E(EXDATE,7,8)_"/"_$E(EXDATE,3,4)
|
|
..I $E(TNODE,1,4)["ZX1|" S BAR=$P(TNODE,"|",16) D LIST Q
|
|
..D LIST
|
|
Q
|
|
EXIT K TTNODE,IDATE,EDATE,BAR,BRUGNUM,EXDATE,ISSDATE,TNODE,DRUGNM,RXNUM,NODE,NEXT,NEXT2,NM,SS,ZZ,BAT,PHAR,SITE,ST,TDTM,LINE,CNT,TOTORD,TOTRX,RECD,SITEN,X,BEG,END,PSOION,PSXLION,DIC,Y,PSXA,PSXE,PSX1
|
|
K %ZIS,I,NAME,ORDER,PSXB,PSXDA,REC,SSN,ZTDESC,ZTIO,ZTSAVE,ZTSK,ZX,PSXFLAG,DIROUT,DIRUT,DTOUT,DUOUT,DIR,FINISH
|
|
K %DT,%DT(0),%DT("A"),%DT("B")
|
|
D ^%ZISC I $D(IO("Q")) K IO("Q")
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
SUB W @IOF,?18,"CMOP Rejected Messages for Transmission # ",PSXB,!
|
|
D NOW^%DTC S Y=% X ^DD("DD") W ?23,"Printed : ",Y,!! K Y,%
|
|
W "Facility : ",SITE,?40,"Division: ",PHAR
|
|
W !,"Received on ",$P(TDTM,":",1,2),?40,"Total Orders: ",TOTORD,?60,"Total Rx's: ",TOTRX,!
|
|
SUB1 W !,"ORDER",?15,"NAME",?28,"RX NUMBER",?39,"BAR CODE",?54,"DRUG NAME"
|
|
W ! S LINE="-" F I=0:1:79 W LINE
|
|
W ! S CNT=CNT+6
|
|
Q
|
|
LIST I ORDER'=OR1 W !!,$P(ORDER,"-",3)," REJECTED REASON: ",REASON
|
|
W !,?6,$S($G(NAME1)'=NAME:$E(NAME,1,20),1:"")
|
|
W ?28,RXNUM,?39,BAR,?54,$E(DRUGNM,1,25)
|
|
S NAME1=NAME
|
|
S CNT=CNT+1,OR1=ORDER,PSXFLAG=1
|
|
I CNT>56 D SUB1 S CNT=0
|
|
K DRUGNUM,DRUGNM,RXNUM,ISSDATE,EXDATE,BAR,REASON
|
|
Q
|