source: FOIAVistA/trunk/r/CMOP-PSX/PSXREJ.m@ 1397

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