177 lines
8.6 KiB
Mathematica
177 lines
8.6 KiB
Mathematica
PSXRTRAN ;BIR/WPB/PDW-Batch Retransmission Routine ;13 Mar 2002 3:09 PM
|
|
;;2.0;CMOP;**18,27,31,41,51**;11 Apr 97
|
|
;Reference to ^PS(59, supported by DBIA #1976
|
|
;Reference to ^PS(59.7 supported by DBIA #694
|
|
;Reference to ^PSRX( supported by DBIA #1977
|
|
;
|
|
START I '$D(^XUSEC("PSXCMOPMGR",DUZ)) D NO Q
|
|
I '$D(^XUSEC("PSXRTRAN",DUZ)) D NO Q
|
|
I '$D(^XUSEC("PSX XMIT",DUZ)) D NO Q
|
|
D SET^PSXSYS
|
|
I '$D(PSXSYS) W !,"CMOP processing is inactivated, re-transmission of data not allowed." Q
|
|
S PSXJOB=2
|
|
I $D(^PSX(550,"TR","T")) W !,"There is another job in progress, try again later." G EXIT
|
|
L +PSX(550.1):3 I '$T W !,"There is another job in progress, try again later." G EXIT
|
|
I '$D(^PSX(550.2,"AX")) W !!,"No data to re-transmit." G EXIT
|
|
S DIC="^PSX(550.2,",DIC(0)="AMZEQ",DIC("S")="I ($D(^PSX(550.2,""AX"",+Y))),($P($G(^PSX(550.2,+Y,1)),U,3)=""""),($P($G(^PSX(550.2,+Y,1)),U,1)="""")"
|
|
D ^DIC K DIC,DIC("S"),DIC(0)
|
|
G:$D(DTOUT)!($D(DUOUT))!($G(Y)'>0) EXIT
|
|
S OLDBAT=+Y K Y,TRAN,TRANI
|
|
D GETS^DIQ(550.2,OLDBAT,".01;2;3;5;14;17","","TRAN"),TOP^PSXUTL("TRAN") ;external of fields
|
|
D GETS^DIQ(550.2,OLDBAT,".01;2;3;5;14;17","I","TRANI"),TOP^PSXUTL("TRANI") ;internal of fields
|
|
S OLDBATNM=TRAN(.01)
|
|
W !,"Transmission: "_TRAN(.01)
|
|
W !,"Date: "_TRAN(5)
|
|
W !,"Division: "_TRAN(2)
|
|
W !,"Type: "_TRAN(17)
|
|
W !,"CMOP Host: "_TRAN(3)
|
|
W !,"Total RXs: "_TRAN(14)
|
|
S TYP=$S(TRANI(17)="C":"CS",1:"STD")
|
|
S PSXCS=$S(TYP="CS":1,1:0) D SET^PSXSYS
|
|
I TRANI(3)'=+PSXSYS W !!,$$GET1^DIQ(550,+PSXSYS,.01)_" is the active host for transmitting "_TRAN(17) G EXIT
|
|
CLOSED S CLOSED=$P($G(^PSX(550.2,OLDBAT,1)),U,1)
|
|
I CLOSED'="" W !,"The transmission selected has been acknowledged and cannot be re-transmitted." D RESET G EXIT
|
|
I $P($G(^PSX(550.2,OLDBAT,1)),U,2)'="" W !!,"This transmission has been re-transmitted once and cannot",!,"be retransmitted again." D RESET G ERRMSG^PSXERR1
|
|
W !!
|
|
S BMSG=$P($G(^PSX(550.2,OLDBAT,1)),U,5)-1,EMSG=$P($G(^PSX(550.2,OLDBAT,1)),U,6),PSOSITE=$P($G(^PSX(550.2,OLDBAT,0)),"^",3)
|
|
S PSXSTART=BMSG+1,PSXDUZ=DUZ,PSXSITE=$P($G(PSXSYS),U,3)
|
|
S SNDR=$$GET1^DIQ(200,$P($G(^PSX(550.2,OLDBAT,0)),U,5),.01)
|
|
S DIV=$P($G(^PS(59,$P($G(^PSX(550.2,OLDBAT,0)),U,3),0)),U,1),Y=$P($G(^PSX(550.2,OLDBAT,0)),U,6) X ^DD("DD") S TRNDT=Y
|
|
W !," *** Coordinate re-transmissions with ",$$GET1^DIQ(550,+PSXSYS,.01)," CMOP ***",!
|
|
S DIR(0)="Y^O",DIR("B")="NO",DIR("A")="Are you sure you want to Re-transmit this batch" D ^DIR K DIR
|
|
I Y=0!($D(DIRUT)) D RESET G EXIT
|
|
QUE ;
|
|
F YY="PSXMFLAG","BMSG","EMSG","PSXSYS","OLDBAT*","PSXDUZ","PSXJOB","PSXSITE","PSOSITE","PSXSTART","PSXJOB","PSXSITE","TRAN*","PSXCS" S ZTSAVE(YY)=""
|
|
S ZTDTH=$H,ZTSAVE("ZZDATA")="",ZTIO="",ZTRTN="ENTRAN^PSXRTRAN",ZTDESC="CMOP Retransmission"
|
|
D ^%ZTLOAD ;****TESTING
|
|
;D ENTRAN S PSXSTAT="H" D PSXSTAT^PSXRSYU G EXIT ;****TESTING ;to run in the foreground uncomment this line and comment out the previous line
|
|
I $D(ZTSK)[0 W !!,"Job Cancelled" G EXIT
|
|
E W !!,"Re-transmission Queued "_ZTSK
|
|
S PSXSTAT="T" D PSXSTAT^PSXRSYU
|
|
G EXIT
|
|
TXT I $G(ORD)]"" S LCNT=LCNT+1,^XMB(3.9,XMZ,2,LCNT,0)=ORD
|
|
Q
|
|
ENTRAN ;Entry for data transmission
|
|
LOCK ; >>>**** LOCK OF FILE 550.1 ****<<<
|
|
F I=1:1:3 L +^PSX(550.1):6 I $T S I=100
|
|
I I'=100 D CANMSG G EXIT ; could not get a lock in 18 minutes of waiting
|
|
K ^TMP($J,"PSX"),^TMP($J,"PSXDFN"),ZCNT,PSXBAT
|
|
S PSOPAR=^PS(59,PSOSITE,1)
|
|
S PSXTDIV=PSOSITE,PSXTYP=$S(+$G(PSXCS):"C",1:"N")
|
|
S PSOLAP=ION,PSOSYS=$G(^PS(59.7,1,40.1)),PSXTRANS=1,PSXFLAG=1
|
|
S PSOINST=+$P(PSXSYS,"^",2)
|
|
S PSXVENDR="AUTOMATED SYSTEM"
|
|
S PSXRTRAN=1,PSXRTRN=1,ZTREQ="@"
|
|
RESETRX ; pull, reset RXs from 550.2 RX multiple, if released do not send, make report
|
|
K ^TMP($J,"PSXRTRAN"),LCNT
|
|
S PSXERFLG=0 S PSXFLAG=1,PSXRTRAN=1
|
|
F NI=1:1 Q:'$D(^PSX(550.2,OLDBAT,15,NI,0)) S XX=^(0) D
|
|
. N NI
|
|
. S RXDA=$P(XX,U,1),FILL=$P(XX,U,2),DFN=$P(XX,U,3),REC=$P(XX,U,5)
|
|
. S TEST=$$TESTREL(RXDA,FILL) ; test & catalog RXs for report, 'SENT' if OK, "FILL '=" if more recent fill, 'released date' if released
|
|
. Q:TEST'="SENT"
|
|
. Q:'$D(^PS(52.5,"B",RXDA)) ;RX pulled early from suspense
|
|
. D RESET^PSXNEW(RXDA,FILL,"Re-Trans of "_OLDBAT)
|
|
. D SDT ;test/set RX into 550.2
|
|
;
|
|
I '$G(PSXBAT) D NOTRAN G EXIT ;no RXs passed retesting
|
|
I PSXERFLG=1 S PSXJOB=7 D ^PSXERR
|
|
D EN^PSXBLD ; build 550.1 entries related to PSXBAT
|
|
I PSXERFLG=1 S PFLAG=1 D EN^PSXERR
|
|
S OLDSDT=$P($G(^PSX(550.2,OLDBAT,0)),"^",6)
|
|
S PSXSENDR=$$GET1^DIQ(200,PSXDUZ,.01),(SITEN,SITENUM)=$P($G(PSXSYS),U,2),PSXEND=EMSG,PSXDIV=$P($G(^PS(59,+PSOSITE,0)),U,1),XSITE=$P($G(^PS(59,+PSOSITE,0)),U,6)
|
|
S PSXSTART=$O(^PSX(550.1,"C",PSXBAT,0)),(PSXEND,EMSG)=$O(^PSX(550.1,"C",PSXBAT,"A"),-1)
|
|
S PSXBATNM=$$GET1^DIQ(550.2,PSXBAT,.01)
|
|
S PSXHDR=PSXSITE_U_+PSXSYS_U_SITENUM_U_PSXTDT_U_PSXSENDR_U_PSXSTART_U_EMSG_U_PSXDIV_U_XSITE,PSXREF=SITENUM_"-"_PSXBATNM
|
|
N DOMAIN,LCNT,XMDUZ,XMSUB,XMZ,ORD
|
|
S (LCNT,PSXMSGCT,PSXRXCT)=0
|
|
S X=$$KSP^XUPARAM("INST"),DIC="4",DIC(0)="MOXZ" D ^DIC S SITEX=$P(Y,"^",2),XMDUZ=.5 K X,Y,DIC
|
|
XMZ S XMSUB="CMOP Retransmission Update from "_SITEX
|
|
D XMZ^XMA2
|
|
I XMZ'>0 H 2 G XMZ
|
|
HDR ;Get header data
|
|
S ORD="$$RMIT"_U_PSXBATNM_U_PSXHDR_U_OLDBATNM D TXT
|
|
S PSXTYP=TRANI(17),PSXTDIV=TRANI(2)
|
|
S ORD=$G(PSXORD("A")) D TXT
|
|
S:$G(PSXORD("B",1))="" PSXORD("B",1)="NTE|2||"
|
|
S:$G(PSXORD("C",1))="" PSXORD("C",1)="NTE|3||"
|
|
S:$G(PSXORD("D",1))="" PSXORD("D",1)="NTE|4||"
|
|
F ZZ="B","C","D" S Z=0 F S Z=$O(PSXORD(ZZ,Z)) Q:Z'>0 S ORD=$G(PSXORD(ZZ,Z)) D TXT
|
|
MSG ;Get patient order data
|
|
S (LMSG,MSG)=0
|
|
F S MSG=$O(^PSX(550.1,"C",PSXBAT,MSG)) Q:MSG'>0 S:$G(MCT)'>0 MCT=MSG S LMSG=MSG,PSXMSGCT=PSXMSGCT+1,LNTX=+$P(^PSX(550.1,MSG,"T",0),U,4) D
|
|
.S ORD="$MSG^"_+$G(^PSX(550.1,MSG,0))_U_LNTX D TXT
|
|
.F PSX=1:1:LNTX I $G(^PSX(550.1,MSG,"T",PSX,0))]"" S ORD=$G(^(0)) S:$E(ORD,1,7)="ORC|NW|" PSXRXCT=PSXRXCT+1 D TXT
|
|
.S DA=MSG,DIE="^PSX(550.1,",DR="1///2;5////"_$H_";3////"_PSXBAT D ^DIE K DIE,DA,DR
|
|
.S REC=MSG,PSXRTRN=1 ;D SUSPS^PSXRXU
|
|
S ORD="$$ENDRMIT^"_U_U_PSXBATNM_U_PSXMSGCT_U_PSXRXCT D TXT K ORD
|
|
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_U_LCNT_U_DT,XMDUN="CMOP Manager"
|
|
S XMDUZ=.5
|
|
S RECV=$P($G(^PSX(550,+PSXSYS,0)),U,4),DOMAIN="@"_$$GET1^DIQ(4.2,RECV,.01)
|
|
;code to divert patient transmissions for testing
|
|
I '$D(^XTMP("PSXDIVERTCMOP")) S XMY("S.PSXX CMOP SERVER"_DOMAIN)="" I 1 ;****TESTING
|
|
E S XX=^XTMP("PSXDIVERTCMOP",1) S XMY(XX)="" H 1 ;****TESTING S.PSXX
|
|
D ENT1^XMD
|
|
K DIE,DA,DR,BAT,PSX,PSXORD
|
|
FILE L +^PSX(550.2,PSXBAT):30 G:'$T FILE
|
|
D NOW^%DTC S PSXTRDTM=%
|
|
S PSXLAST=LMSG,PSXFRST=MCT,DA=PSXBAT,DIE="^PSX(550.2,"
|
|
S DR="1////2;9////"_OLDBAT_";11////"_PSXFRST_";12////"_PSXLAST_";13////"_PSXMSGCT_";14////"_PSXRXCT_";5////"_PSXTRDTM D ^DIE
|
|
L -^PSX(550.2,PSXBAT) K DA,DIE
|
|
F1 L +^PSX(550.2,OLDBAT):30 G:'$T F1
|
|
S DA=OLDBAT,DIE="^PSX(550.2,",DR="1////5;8////"_PSXBAT D ^DIE
|
|
L -^PSX(550.2,OLDBAT) K DA,DIE
|
|
S PSXOLD=OLDBAT
|
|
D AFTER1^PSXRSYU ;set PSXBAT into 550
|
|
S PSXFLAG=1,PSXRTRN=1
|
|
D EN^PSXNOTE
|
|
S OLDBAT=PSXOLD
|
|
D START^PSXRXU ;update RXs in 52.5 & 52
|
|
D OERRCLR^PSXRSUS
|
|
S OLDBAT=PSXOLD
|
|
D SETSTAT^PSXRTRA1
|
|
D REPORT^PSXRTRA1
|
|
RESET S PSXSTAT="H" D PSXSTAT^PSXRSYU
|
|
G EXIT
|
|
Q
|
|
NO W !,"You are not authorized to use this option!" Q
|
|
EXIT S ZTREQ="@"
|
|
L -^PSX(550.1)
|
|
K PSXSTART,PSXEND,PSXRXCT,PSXMSGCT,PSXLAST,PSXSITE,PSXTDT,LASTBAT,LCNT,CNTX,MSG,REC,SITENUM,XQAMSG,XX,XMY,XMSUB,XMFROM,XMZ,XMDUZ,XMDUN,LNCT,OLDBAT,PSXMFLAG,FLAG,PSXSENDR,BMSG,EMSG,RECV,DOMAIN,CLOSED,PSXDIV,XSITE
|
|
K %,DIV,LNTX,SNDR,STATUS,TRNDT,Z,ZZ,PSXHDR,PSXJOB,PSXRTRN,PSXSTAT,PSXFRST,PSXBAT,PSXDUZ,PSXFLAG,DIR,Y,X,OLDSDT,S1,Y,DIRUT,DIROUT,DTOUT,DUOUT,BAD,MCT,LMSG,PSXOLD,PSXRXD
|
|
K ^PSX("CMOP TRANS"),PSXBATNM,OLDBATNM,TRAN,TRANI,PSXTRDTM,I
|
|
K ^TMP($J)
|
|
Q
|
|
CANMSG ; lock on 550.1 not achieved send transmission cancelled message
|
|
D CANMSG^PSXRTRA1
|
|
Q
|
|
TESTREL(RXDA,FILL) ; test release date, gather RX data, store for report
|
|
;returns SENT, "FILL '=", or Released Date
|
|
N DFN,VADM,SSN,RELDT,RELDTE,PATNM,REPLY,FILLX
|
|
S DFN=$$GET1^DIQ(52,RXDA,2,"I"),PATNM=$$GET1^DIQ(52,RXDA,2)
|
|
D DEM^VADPT S SSN=$P(VADM(2),U,2)
|
|
S RXNM=$P(^PSRX(RXDA,0),U)_"-"_FILL
|
|
I FILL=0 S RELDT=$P(^PSRX(RXDA,2),U,13)\1 I 1
|
|
E S RELDT=$P(^PSRX(RXDA,1,FILL,0),U,18)\1
|
|
S REPLY="SENT"
|
|
S:RELDT REPLY=$$FMTE^XLFDT(RELDT)
|
|
S FILLX=+$O(^PSRX(RXDA,1,"A"),-1) I FILL'=FILLX S REPLY="Fill '= "_FILLX
|
|
Q REPLY
|
|
NOTRAN ;no RXs passed testing to go into a new transmission
|
|
S XMSUB="Retransmission of "_OLDBATNM_" failed"
|
|
K TXT,XMY
|
|
S TXT(1,0)="No prescriptions passed testing to go into a new transmission"
|
|
S XMTEXT="TXT("
|
|
D GRP^PSXNOTE
|
|
D ^XMD
|
|
Q
|
|
SDT ;functional code as to SDT^PSXRPPL test and set individual RXs into 550.2
|
|
N SDT
|
|
S REC=$O(^PS(52.5,"B",RXDA,0)) Q:'REC
|
|
S XX=^PS(52.5,REC,0),SDT=$P(XX,U,2)
|
|
S XDFN=DFN
|
|
N RXN,RXDA,FILL
|
|
D GETDATA^PSXRPPL ;if RX is OK makes entry into new batch PSXBAT
|
|
D:$G(RXN) PSOUL^PSSLOCK(RXN),OERRLOCK^PSXRPPL(RXN)
|
|
Q
|