source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXREJ.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1PSXREJ ;BIR/BAB-Rejected Messages Report ;04/08/97 2:06 PM
2 ;;2.0;CMOP;**38**;11 Apr 97
3EN ;GET BEGIN DATE
4 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
5 S PSXA=$P(Y,".",1),START=$$FMTE^XLFDT(Y,"1D")
6ENDATE ;GET ENDING DATE
7 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
8 S PSXE=$P(Y,".",1),FINISH=$$FMTE^XLFDT(Y,"1D")
9 K X,Y
10 I PSXE<PSXA W !,"Ending date must follow beginning date!" G ENDATE
11 S PSXA=PSXA-.00001,PSXE=PSXE+.99999
12END S %ZIS="Q" D ^%ZIS S PSXLION=ION I POP W !,"No Device Selected" G EXIT
13 I $D(IO("Q")) D QUE G EXIT
14 D START,EXIT
15 Q
16QUE ;
17 S ZTRTN="START^PSXREJ",ZTDESC="CMOP Rejected Messages Report"
18 S ZTSAVE("PSXB")="",ZTSAVE("PSXDA")=""
19 S ZTSAVE("PSXLION")="",ZTSAVE("PSXA")="",ZTSAVE("PSXE")=""
20 S ZTSAVE("START")="",ZTSAVE("FINISH")=""
21 S ZTIO=PSXLION D ^%ZTLOAD
22 I $D(ZTSK)[0 W !!,"Job Canceled"
23 E W !!,"Job Queued"
24 D HOME^%ZIS Q
25 ;Called by Taskman to start the Rejected Messages Report
26START ;
27 U IO
28 F S PSXA=$O(^PSX(552.1,"AP",PSXA)) Q:(PSXA']""!(PSXA>PSXE)) D
29 .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
30 I '$G(PSXFLAG) W !!,"There were no rejected messages for the date range selected: ",START," to ",FINISH
31 G EXIT
32REF ;
33 I '$D(^PSX(552.2,"AR",PSXB)) Q
34 Q:'$D(^PSX(552.1,PSXDA,0))
35 S SITEN=+$P(^PSX(552.1,PSXDA,0),U,1)
36 Q:$G(SITEN)']""
37 ;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
38 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
39 S X=$P(^PSX(552.1,PSXDA,0),U,4),TDTM=$$FMTE^XLFDT(X,"1P")
40 S TOTRX=$P($G(^PSX(552.1,PSXDA,1)),U,4)
41 S TOTORD=$P($G(^PSX(552.1,PSXDA,1)),U,3)
42 ;
43 ;
44 S OR1=0
45 S (REC,CNT)=0 D SUB F S REC=$O(^PSX(552.2,"AR",PSXB,REC)) Q:REC'>0 D GETDATA
46 ;G EXIT
47 Q
48GETDATA ;
49 S ORDER=$P($G(^PSX(552.2,REC,0)),"^") S ZZ=0
50 K REASON S REASON=$P($P($G(^PSX(552.2,REC,"ACK")),"MSA|",2),"|",3)
51 F S ZZ=$O(^PSX(552.2,REC,"T",ZZ)) Q:ZZ'>0 S NODE=$G(^PSX(552.2,REC,"T",ZZ,0)) D
52 .Q:$E(NODE,1,4)["MSH|"!($E(NODE,1,4)["NTE|")
53 .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)
54 .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
55 ..Q:$E(TNODE,1,4)["NTE|"
56 ..I $E(TNODE,1,4)["ORC|" S ZZ=ZX Q
57 ..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
58 ...S EDATE=$E(EXDATE,5,6)_"/"_$E(EXDATE,7,8)_"/"_$E(EXDATE,3,4)
59 ..I $E(TNODE,1,4)["ZX1|" S BAR=$P(TNODE,"|",16) D LIST Q
60 ..D LIST
61 Q
62EXIT 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
63 K %ZIS,I,NAME,ORDER,PSXB,PSXDA,REC,SSN,ZTDESC,ZTIO,ZTSAVE,ZTSK,ZX,PSXFLAG,DIROUT,DIRUT,DTOUT,DUOUT,DIR,FINISH
64 K %DT,%DT(0),%DT("A"),%DT("B")
65 D ^%ZISC I $D(IO("Q")) K IO("Q")
66 S:$D(ZTQUEUED) ZTREQ="@"
67 Q
68SUB W @IOF,?18,"CMOP Rejected Messages for Transmission # ",PSXB,!
69 D NOW^%DTC S Y=% X ^DD("DD") W ?23,"Printed : ",Y,!! K Y,%
70 W "Facility : ",SITE,?40,"Division: ",PHAR
71 W !,"Received on ",$P(TDTM,":",1,2),?40,"Total Orders: ",TOTORD,?60,"Total Rx's: ",TOTRX,!
72SUB1 W !,"ORDER",?15,"NAME",?28,"RX NUMBER",?39,"BAR CODE",?54,"DRUG NAME"
73 W ! S LINE="-" F I=0:1:79 W LINE
74 W ! S CNT=CNT+6
75 Q
76LIST I ORDER'=OR1 W !!,$P(ORDER,"-",3)," REJECTED REASON: ",REASON
77 W !,?6,$S($G(NAME1)'=NAME:$E(NAME,1,20),1:"")
78 W ?28,RXNUM,?39,BAR,?54,$E(DRUGNM,1,25)
79 S NAME1=NAME
80 S CNT=CNT+1,OR1=ORDER,PSXFLAG=1
81 I CNT>56 D SUB1 S CNT=0
82 K DRUGNUM,DRUGNM,RXNUM,ISSDATE,EXDATE,BAR,REASON
83 Q
Note: See TracBrowser for help on using the repository browser.