119 lines
8.9 KiB
Mathematica
119 lines
8.9 KiB
Mathematica
PSXHSYS ;BIR/WPB/PDW-Displays System Status at CMOP Host Site ;MAR 1,2002@16:11:17
|
|
;;2.0;CMOP;**32,38**;11 Apr 97
|
|
STATUS ;display CMOP status for entry action on RX menu
|
|
G:$G(END) EXIT
|
|
W @IOF
|
|
K PSX1,ST,ST1,ST2,SITE,XXX,YYY,ZZZ,CNT,BCNT,OCNT,QRY,TQRY,TRX,PSXSTAT,PSXTXT,QT,ACKT,DOWN,DORD,DRX,DQRY,DTQRY,SP,SP1,X1,X2,X3,X4,SP3,SP2,ACKTM,SP4,SP5,X5,X6,SP6,END,PSXTXT,PSXTXT1,PSXTXT3
|
|
K AF,AFNXT,ANXT,ARF,ATM,CQRY,DB,DBF,DBNXT,DNXT,IEN512,IN5521,LFP,LR,LRF,LRFP,O,QFLG,QTM,RF,RFANXT,RFPNXT,RNXT,SQRY,STAT,STRT,TRANS,TTRX,RFNXT,RFP,AFNS,DBNS,RFNS,RFPNS,XBAT,XREC,ZTSK,ZZZ
|
|
N PSXSTAT,PSXTXT
|
|
S PSXSTAT=$G(^PSX(553,1,"S"))
|
|
Q:PSXSTAT=""
|
|
N PSX1,PSX2 S (CNT,BCNT,OCNT,TRX,QFLG,TTRX,DOWN,DORD,DRX,DQRY,DTQRY)=0
|
|
S QRY=$P(^PSX(553.1,0),"^",3)
|
|
S STAT=$P(^PSX(553.1,QRY,0),"^",5) D
|
|
.I $G(STAT)'=1&($G(STAT)'=5) S QRY=QRY-1 S TRX=$P(^PSX(553.1,QRY,0),"^",6),QT=$$FMTE^XLFDT($P($G(^PSX(553.1,QRY,0)),"^",4),1),QTM=$P(QT,",",1)_"@"_$P($P(QT,"@",2),":",1,2) S:$G(TRX)="" TRX=0 Q
|
|
.I $G(STAT)=5 S QFLG=1,TTRX=$P(^PSX(553.1,QRY,0),"^",6) S:$G(TRX)="" TTRX=0 S TRX=$P(^PSX(553.1,QRY-1,0),"^",6) S:$G(TRX)="" TRX=0 Q
|
|
.I $G(STAT)=1 S TRX=$P(^PSX(553.1,QRY,0),"^",6),QT=$$FMTE^XLFDT($P($G(^PSX(553.1,QRY,0)),"^",4),1),QTM=$P(QT,",")_"@"_$P($P(QT,"@",2),":",1,2) S:$G(TRX)="" TRX=0
|
|
S PSX1=$G(^PSX(553,1,99)) S:$G(PSX1)>0 TRANS=$P(PSX1,"-",1,2),IN5521=$O(^PSX(552.1,"B",$G(TRANS),"")),SITE=$P(^PSX(552.1,IN5521,"P"),"^"),IEN512=$O(^PSX(552.2,"B",PSX1,"")) D
|
|
.S:$G(PSX1)'>0 PSX1="Nothing Downloaded"
|
|
.S:$G(IEN512)>0 ATM=$$HTE^XLFDT($P($G(^PSX(552.2,IEN512,0)),"^",4),1),ACKTM=$P(ATM,",",1)_"@"_$P($P(ATM,"@",2),":",1,2)
|
|
.S:$G(ACKTM)="" ATM=$$FMTE^XLFDT($P(^PSX(552.1,IN5521,0),"^",6)),ACKTM=$P(ATM,",",1)_"@"_$P($P(ATM,"@",2),":",1,2)
|
|
I '$D(^PSX(552.1,"AQ")) S CNT=0
|
|
I $D(^PSX(552.1,"AQ")) S XXX="" F S XXX=$O(^PSX(552.1,"AQ",XXX)) Q:'XXX S BCNT=BCNT+1,YYY="" F S YYY=$O(^PSX(552.1,"AQ",XXX,YYY)) Q:'YYY S ZZZ=0 F S ZZZ=$O(^PSX(552.1,"AQ",XXX,YYY,ZZZ)) Q:ZZZ'>0 D
|
|
.S CNT=$P($G(^PSX(552.1,ZZZ,1)),"^",4)+CNT,OCNT=$P($G(^PSX(552.1,ZZZ,1)),"^",3)+OCNT
|
|
S STRT=DT_".0000" F S STRT=$O(^PSX(552.1,"AP",STRT)) Q:STRT'>0 S XBAT="" F S XBAT=$O(^PSX(552.1,"AP",STRT,XBAT)) Q:XBAT="" S XREC=0 F S XREC=$O(^PSX(552.1,"AP",STRT,XBAT,XREC)) Q:XREC'>0 D
|
|
.S DOWN=$G(DOWN)+1,DORD=$G(DORD)+$P(^PSX(552.1,XREC,1),"^",3),DRX=$G(DRX)+$P(^PSX(552.1,XREC,1),"^",4)
|
|
S SQRY=$G(QRY)-30,CQRY=DT_".0000" F S SQRY=$O(^PSX(553.1,SQRY)) Q:SQRY'>0 I $P(^PSX(553.1,SQRY,0),"^",2)>CQRY S DQRY=$G(DQRY)+1,DTQRY=$G(DTQRY)+$P(^PSX(553.1,SQRY,0),"^",6)
|
|
S RF=$O(^PSX(554,"AB","")) S:$G(RF)'>0 RFNS=1 D
|
|
.Q:$G(RFNS)=1
|
|
.S ZTSK=$P(^PSX(554,1,1,RF,0),"^",3),LR=$$FMTE^XLFDT($P(^PSX(554,1,1,RF,0),"^",9)) D ISQED^%ZTLOAD S:$G(ZTSK(0))=0!($G(ZTSK(0))=1) RNXT=$$FMTE^XLFDT($$HTFM^XLFDT($G(ZTSK("D"))))
|
|
.S LRF=$P(LR,",",1)_"@"_$P($P(LR,"@",2),":",1,2),RFNXT=$P(RNXT,",",1)_"@"_$P($P(RNXT,"@",2),":",1,2) S:$G(LR)="" LRF="" S:$G(RNXT)="" RFNXT=""
|
|
S DB=$O(^PSX(554,"AD","")) S:$G(DB)'>0 DBNS=1 D
|
|
.Q:$G(DBNS)=1
|
|
.S ZTSK=$P(^PSX(554,1,1,DB,0),"^",3),DB=$$FMTE^XLFDT($P(^PSX(554,1,1,DB,0),"^",9)) D ISQED^%ZTLOAD S:$G(ZTSK(0))=0!($G(ZTSK(0))=1) DNXT=$$FMTE^XLFDT($$HTFM^XLFDT($G(ZTSK("D"))))
|
|
.S DBF=$P(DB,",",1)_"@"_$P($P(DB,"@",2),":",1,2),DBNXT=$P(DNXT,",",1)_"@"_$P($P(DNXT,"@",2),":",1,2) S:$G(DB)="" DBF="" S:$G(DNXT)="" DBNXT=""
|
|
S RFP=$O(^PSX(554,"AR","")) S:$G(RFP)'>0 RFPNS=1 D
|
|
.Q:$G(RFPNS)=1
|
|
.S ZTSK=$P(^PSX(554,1,1,RFP,0),"^",3),LFP=$$FMTE^XLFDT($P(^PSX(554,1,1,RFP,0),"^",9)) D ISQED^%ZTLOAD S:$G(ZTSK(0))=0!($G(ZTSK(0))=1) RFANXT=$$FMTE^XLFDT($$HTFM^XLFDT($G(ZTSK("D"))))
|
|
.S LRFP=$P(LFP,",",1)_"@"_$P($P(LFP,"@",2),":",1,2),RFPNXT=$P(RFANXT,",",1)_"@"_$P($P(RFANXT,"@",2),":",1,2) S:$G(LFP)="" LRFP="" S:$G(RFANXT)="" RFPNXT=""
|
|
S AF=$O(^PSX(554,"AS","")) S:$G(AF)'>0 AFNS=1 D
|
|
.Q:$G(AFNS)=1
|
|
.S ZTSK=$P(^PSX(554,1,1,AF,0),"^",3),AF=$$FMTE^XLFDT($P(^PSX(554,1,1,AF,0),"^",9)) D ISQED^%ZTLOAD S:$G(ZTSK(0))=0!($G(ZTSK(0))=1) ANXT=$$FMTE^XLFDT($$HTFM^XLFDT($G(ZTSK("D"))))
|
|
.S ARF=$P(AF,",",1)_"@"_$P($P(AF,"@",2),":",1,2),AFNXT=$P(ANXT,",",1)_"@"_$P($P(ANXT,"@",2),":",1,2) S:$G(AF)="" ARF="" S:$G(ANXT)="" AFNXT=""
|
|
S X1=(18-$L(PSX1)),X2=(23-$L(SITE)),X3=$S($G(QFLG)=0:(17-$L(QRY)),1:(18-$L((QRY-1)))),X4=(18-$L(TRX)),TRX=TRX_" Rx's",X5=(23-$L(TRX)),X6=(18-$L(BCNT))
|
|
F I=1:1:X1 S SP=$G(SP)_"."
|
|
F J=1:1:X2 S SP1=$G(SP1)_"."
|
|
F K=1:1:X3 S SP2=$G(SP2)_"."
|
|
F M=1:1:X4 S SP3=$G(SP3)_"."
|
|
F L=1:1:X5 S SP5=$G(SP5)_"."
|
|
F N=1:1:X6 S SP6=$G(SP6)_"."
|
|
F O=1:1:77 S PSXTXT3=$G(PSXTXT3)_"*"
|
|
S SP4="...........",PSXTXT1="*****Release Data Acknowledgements > 24 hours OUTSTANDING*****",PSXTXT2="*****Rejected Orders OUTSTANDING*****"
|
|
K I,J,K,M,L,N,O
|
|
S END=1
|
|
D RPT G:$G(PSXIN)=1 ASK G:$G(PSXIN)'=1 ASK1
|
|
G EXIT
|
|
Q
|
|
ASK R !,"Enter ""^"" to quit",END:30 G:$G(END)["^" EXIT K END G STATUS
|
|
ASK1 S DIR(0)="E" D ^DIR G:$G(Y)["^"!($G(DIRUT))!($G(DIROUT))!($G(DTOUT))!($G(DUOUT)) EXIT G EXIT
|
|
RPT S PSXTXT="CMOP SYSTEM STATUS"
|
|
W !!,?((IOM\2)-($L(PSXTXT)\2)),PSXTXT
|
|
W !!," Interface",?23,": ",$S(PSXSTAT="R":"RUNNING",1:"STOPPED")
|
|
W:$G(BCNT)>0 !!," Transmissions Queued",?23,": ",$G(BCNT),SP6,"Orders/Rx's: ",$G(OCNT),"/",$G(CNT)
|
|
W:$G(BCNT)'>0 !!," Transmissions Queued",?23,": ","Nothing in the Queue"
|
|
W !!," Last Order Processed ",?23,": ",$G(PSX1),$G(SP),$G(SITE),$G(SP1),$G(ACKTM)
|
|
W !!," Last Query Completed",?23,": #",$S($G(QFLG)=0:$G(QRY),$G(QFLG)=1:$G(QRY)-1,1:""),$G(SP2),$G(TRX),$G(SP5),$G(QTM)
|
|
W:$D(^PSX(554,"AC")) !!,?((IOM\2)-($L(PSXTXT1)\2)),PSXTXT1
|
|
W:$D(^PSX(552.2,"AR")) !!,?((IOM\2)-($L(PSXTXT2)\2)),PSXTXT2
|
|
W:('$D(^PSX(552.2,"AR"))&('$D(^PSX(554,"AC")))) !!," ",PSXTXT3
|
|
W !!," Background Process",?43,"Last Ran",?66,"Scheduled For"
|
|
W !!," Release Data Filed in Master Database.....",?43,$G(LRF),SP4,$S($G(RFNS)=1:"Not Scheduled",1:$G(RFNXT))
|
|
W !," Database Purge............................",?43,$G(DBF),SP4,$S($G(DBNS)=1:"Not Scheduled",1:$G(DBNXT))
|
|
W !," Release File Purge........................",?43,$G(LRFP),SP4,$S($G(RFPNS)=1:"Not Scheduled",1:$G(RFPNXT))
|
|
W !," Release Acknowledgement File Purge........",?43,$G(ARF),SP4,$S($G(AFNS)=1:"Not Scheduled",1:$G(AFNXT))
|
|
Q
|
|
EXIT K PSX1,ST,ST1,ST2,SITE,XXX,YYY,ZZZ,CNT,BCNT,OCNT,QRY,TQRY,TRX,PSXSTAT,PSXTXT,QT,ACKT,DOWN,DORD,DRX,DQRY,DTQRY,SP,SP1,X1,X2,X3,X4,SP3,SP2,ACKTM,SP4,SP5,X5,X6,SP6,END,PSXTXT,PSXTXT1,PSXTXT3,PSXTXT2,PSXIN
|
|
K AF,AFNXT,ANXT,ARF,ATM,CQRY,DB,DBF,DBNXT,DNXT,IEN512,IN5521,LFP,LR,LRF,LRFP,O,QFLG,QTM,RF,RFANXT,RFPNXT,RNXT,SQRY,STAT,STRT,TRANS,TTRX,RFNXT,RFP,AFNS,DBNS,RFNS,RFPNS,XBAT,XREC,ZTSK,ZZZ
|
|
Q
|
|
EDIT ;Enter/Edit site parameters on the CMOP host facility system.
|
|
I $D(^XUSEC("PSXDOD",DUZ)) D EDITDOD^PSXHSYS1 ; setup interagency import parameters
|
|
S (QA,QI)=$P(^PSX(553,1,0),"^",9),QLR=$P(^PSX(553,1,0),"^",8) S:$G(QI)="" QI=1 S:$G(QLR)'>0 QLR=10000
|
|
I $G(QI)["." S LEN=$L($P(QI,".",2)) S:$G(LEN)=1 QI=$G(QI)_"0"
|
|
S HR=$P(QI,".")_" hr ",MIN=(60*($P(QI,".",2)/100))_" min" S:$P(QI,".",2)="" MIN=""
|
|
S QRI=$S($P(QI,".")>0:$G(HR)_$G(MIN),1:$G(MIN))
|
|
S REC=$O(^PSX(554,"AS","")) I $G(REC)>0 S RAS=$P(^PSX(554,1,1,$G(REC),0),"^",8) S:$G(RAS)'>0 RAS=10
|
|
QRI W !!,"Query Request Interval: ",$G(QRI),"// " R QRYINT:DTIME
|
|
G:$G(QRYINT)["^" EXIT1
|
|
S QIA=QRYINT S:QRYINT="" QIA=QI
|
|
I $G(QIA)["." S LEN=$L($P(QIA,".",2)) S:$G(LEN)=1 QIA=$G(QIA)_"0"
|
|
S HR=$P(QIA,".")_" hr ",MIN=(60*($P(QIA,".",2)/100))_" min" S:$P(QIA,".",2)="" MIN=""
|
|
S QRIB=$S($P(QIA,".")>0:$G(HR)_$G(MIN),1:$G(MIN))
|
|
W:$G(QRIB) " ( ",$G(QRIB),")"
|
|
I $G(QRYINT)["?" W !!,"This is the minimum time interval between query requests.",!,"Enter the number in hour(s) and/or fractions of an hour interval.",!,"Example: 1.25 = 12 hr 25 min, .30 = 30 min, 1 = 1 hr.",! G QRI
|
|
S:$G(QRYINT)'>0 QRYINT=$G(QA)
|
|
S DR="14///"_$G(QRYINT),DIE="^PSX(553,",DA=1
|
|
L +^PSX(553,1):600 Q:'$T D ^DIE L -PSX(553,1) K DA,DR,DIE
|
|
G:$P(^PSX(553,1,0),"^",9)'=$G(QRYINT) QRI
|
|
QLR W !,"Query Limit Request: ",$G(QLR)," Rx's// " R QLIM:DTIME
|
|
G:$G(QLIM)["^" EXIT1
|
|
I $G(QLIM)["?" W !!,"This is the maximum number of Rx's that will be accepted during a query request.",! G QLR
|
|
S:$G(QLIM)="" QLIM=$G(QLR)
|
|
I $G(QLIM)'?1.5N W !,"Enter a numeric value between 1 and 99999." G QLR
|
|
I $G(QLIM)'>0&($G(QLIM)'<99999) W !,"Enter a numeric value between 1 and 99999." G QLR
|
|
S $P(^PSX(553,1,0),"^",8)=$G(QLIM)
|
|
G:$G(RAS)="" EXIT1
|
|
RAS W !,"Days to Retain Release Summary: ",$G(RAS)," days// " R ACKSUM:DTIME
|
|
G:$G(ACKSUM)["^" EXIT1
|
|
I $G(ACKSUM)["?" W !!,"This is the number of days of Release Acknowledgements that will be retained in",!,"the file system. Maximum number of days is 10, minimum number of days is 0.",! G RAS
|
|
S:$G(ACKSUM)="" ACKSUM=$G(RAS)
|
|
I $G(ACKSUM)'?1.2N W !,"Enter a number value between 1 and 10." G RAS
|
|
I $G(ACKSUM)>10 W !,"Maximum number of days to keep is 10." G RAS
|
|
I $G(ACKSUM)'>0 W !,"Minimum number of days to keep is 1." G RAS
|
|
;W " ( ",$G(ACKSUM)," )"
|
|
S:$G(REC)'>0 REC=$O(^PSX(554,"AS","")) I $G(REC)>0 S $P(^PSX(554,1,1,$G(REC),0),"^",8)=$G(ACKSUM)
|
|
DRCSTMIS ;edit 554 parameter for "CMOP DRUG Cost Missing" report
|
|
K DR,DA,DIE
|
|
S DA=1,DR=8,DIE=554 L +^PSX(554,1):600 Q:'$T D ^DIE
|
|
L -^PSX(554,1) K DA,DR,DIE
|
|
EXIT1 K QI,QLR,QRI,QRYINT,QRIB,QA,QLIM,QRY,QRYA,RAS,ACKSUM,LEN,REC,HR,MIN,QIA Q
|