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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXHSYS 9236 printed Dec 13, 2024@01:44:17 Page 2
PSXHSYS ;BIR/WPB/PDW-Displays System Status at CMOP Host Site ;MAR 1,2002@16:11:17
+1 ;;2.0;CMOP;**32,38**;11 Apr 97
STATUS ;display CMOP status for entry action on RX menu
+1 if $GET(END)
GOTO EXIT
+2 WRITE @IOF
+3 KILL 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
+4 KILL 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
+5 NEW PSXSTAT,PSXTXT
+6 SET PSXSTAT=$GET(^PSX(553,1,"S"))
+7 if PSXSTAT=""
QUIT
+8 NEW PSX1,PSX2
SET (CNT,BCNT,OCNT,TRX,QFLG,TTRX,DOWN,DORD,DRX,DQRY,DTQRY)=0
+9 SET QRY=$PIECE(^PSX(553.1,0),"^",3)
+10 SET STAT=$PIECE(^PSX(553.1,QRY,0),"^",5)
Begin DoDot:1
+11 IF $GET(STAT)'=1&($GET(STAT)'=5)
SET QRY=QRY-1
SET TRX=$PIECE(^PSX(553.1,QRY,0),"^",6)
SET QT=$$FMTE^XLFDT($PIECE($GET(^PSX(553.1,QRY,0)),"^",4),1)
SET QTM=$PIECE(QT,",",1)_"@"_$PIECE($PIECE(QT,"@",2),":",1,2)
if $GET(TRX)=""
SET TRX=0
QUIT
+12 IF $GET(STAT)=5
SET QFLG=1
SET TTRX=$PIECE(^PSX(553.1,QRY,0),"^",6)
if $GET(TRX)=""
SET TTRX=0
SET TRX=$PIECE(^PSX(553.1,QRY-1,0),"^",6)
if $GET(TRX)=""
SET TRX=0
QUIT
+13 IF $GET(STAT)=1
SET TRX=$PIECE(^PSX(553.1,QRY,0),"^",6)
SET QT=$$FMTE^XLFDT($PIECE($GET(^PSX(553.1,QRY,0)),"^",4),1)
SET QTM=$PIECE(QT,",")_"@"_$PIECE($PIECE(QT,"@",2),":",1,2)
if $GET(TRX)=""
SET TRX=0
End DoDot:1
+14 SET PSX1=$GET(^PSX(553,1,99))
if $GET(PSX1)>0
SET TRANS=$PIECE(PSX1,"-",1,2)
SET IN5521=$ORDER(^PSX(552.1,"B",$GET(TRANS),""))
SET SITE=$PIECE(^PSX(552.1,IN5521,"P"),"^")
SET IEN512=$ORDER(^PSX(552.2,"B",PSX1,""))
Begin DoDot:1
+15 if $GET(PSX1)'>0
SET PSX1="Nothing Downloaded"
+16 if $GET(IEN512)>0
SET ATM=$$HTE^XLFDT($PIECE($GET(^PSX(552.2,IEN512,0)),"^",4),1)
SET ACKTM=$PIECE(ATM,",",1)_"@"_$PIECE($PIECE(ATM,"@",2),":",1,2)
+17 if $GET(ACKTM)=""
SET ATM=$$FMTE^XLFDT($PIECE(^PSX(552.1,IN5521,0),"^",6))
SET ACKTM=$PIECE(ATM,",",1)_"@"_$PIECE($PIECE(ATM,"@",2),":",1,2)
End DoDot:1
+18 IF '$DATA(^PSX(552.1,"AQ"))
SET CNT=0
+19 IF $DATA(^PSX(552.1,"AQ"))
SET XXX=""
FOR
SET XXX=$ORDER(^PSX(552.1,"AQ",XXX))
if 'XXX
QUIT
SET BCNT=BCNT+1
SET YYY=""
FOR
SET YYY=$ORDER(^PSX(552.1,"AQ",XXX,YYY))
if 'YYY
QUIT
SET ZZZ=0
FOR
SET ZZZ=$ORDER(^PSX(552.1,"AQ",XXX,YYY,ZZZ))
if ZZZ'>0
QUIT
Begin DoDot:1
+20 SET CNT=$PIECE($GET(^PSX(552.1,ZZZ,1)),"^",4)+CNT
SET OCNT=$PIECE($GET(^PSX(552.1,ZZZ,1)),"^",3)+OCNT
End DoDot:1
+21 SET STRT=DT_".0000"
FOR
SET STRT=$ORDER(^PSX(552.1,"AP",STRT))
if STRT'>0
QUIT
SET XBAT=""
FOR
SET XBAT=$ORDER(^PSX(552.1,"AP",STRT,XBAT))
if XBAT=""
QUIT
SET XREC=0
FOR
SET XREC=$ORDER(^PSX(552.1,"AP",STRT,XBAT,XREC))
if XREC'>0
QUIT
Begin DoDot:1
+22 SET DOWN=$GET(DOWN)+1
SET DORD=$GET(DORD)+$PIECE(^PSX(552.1,XREC,1),"^",3)
SET DRX=$GET(DRX)+$PIECE(^PSX(552.1,XREC,1),"^",4)
End DoDot:1
+23 SET SQRY=$GET(QRY)-30
SET CQRY=DT_".0000"
FOR
SET SQRY=$ORDER(^PSX(553.1,SQRY))
if SQRY'>0
QUIT
IF $PIECE(^PSX(553.1,SQRY,0),"^",2)>CQRY
SET DQRY=$GET(DQRY)+1
SET DTQRY=$GET(DTQRY)+$PIECE(^PSX(553.1,SQRY,0),"^",6)
+24 SET RF=$ORDER(^PSX(554,"AB",""))
if $GET(RF)'>0
SET RFNS=1
Begin DoDot:1
+25 if $GET(RFNS)=1
QUIT
+26 SET ZTSK=$PIECE(^PSX(554,1,1,RF,0),"^",3)
SET LR=$$FMTE^XLFDT($PIECE(^PSX(554,1,1,RF,0),"^",9))
DO ISQED^%ZTLOAD
if $GET(ZTSK(0))=0!($GET(ZTSK(0))=1)
SET RNXT=$$FMTE^XLFDT($$HTFM^XLFDT($GET(ZTSK("D"))))
+27 SET LRF=$PIECE(LR,",",1)_"@"_$PIECE($PIECE(LR,"@",2),":",1,2)
SET RFNXT=$PIECE(RNXT,",",1)_"@"_$PIECE($PIECE(RNXT,"@",2),":",1,2)
if $GET(LR)=""
SET LRF=""
if $GET(RNXT)=""
SET RFNXT=""
End DoDot:1
+28 SET DB=$ORDER(^PSX(554,"AD",""))
if $GET(DB)'>0
SET DBNS=1
Begin DoDot:1
+29 if $GET(DBNS)=1
QUIT
+30 SET ZTSK=$PIECE(^PSX(554,1,1,DB,0),"^",3)
SET DB=$$FMTE^XLFDT($PIECE(^PSX(554,1,1,DB,0),"^",9))
DO ISQED^%ZTLOAD
if $GET(ZTSK(0))=0!($GET(ZTSK(0))=1)
SET DNXT=$$FMTE^XLFDT($$HTFM^XLFDT($GET(ZTSK("D"))))
+31 SET DBF=$PIECE(DB,",",1)_"@"_$PIECE($PIECE(DB,"@",2),":",1,2)
SET DBNXT=$PIECE(DNXT,",",1)_"@"_$PIECE($PIECE(DNXT,"@",2),":",1,2)
if $GET(DB)=""
SET DBF=""
if $GET(DNXT)=""
SET DBNXT=""
End DoDot:1
+32 SET RFP=$ORDER(^PSX(554,"AR",""))
if $GET(RFP)'>0
SET RFPNS=1
Begin DoDot:1
+33 if $GET(RFPNS)=1
QUIT
+34 SET ZTSK=$PIECE(^PSX(554,1,1,RFP,0),"^",3)
SET LFP=$$FMTE^XLFDT($PIECE(^PSX(554,1,1,RFP,0),"^",9))
DO ISQED^%ZTLOAD
if $GET(ZTSK(0))=0!($GET(ZTSK(0))=1)
SET RFANXT=$$FMTE^XLFDT($$HTFM^XLFDT($GET(ZTSK("D"))))
+35 SET LRFP=$PIECE(LFP,",",1)_"@"_$PIECE($PIECE(LFP,"@",2),":",1,2)
SET RFPNXT=$PIECE(RFANXT,",",1)_"@"_$PIECE($PIECE(RFANXT,"@",2),":",1,2)
if $GET(LFP)=""
SET LRFP=""
if $GET(RFANXT)=""
SET RFPNXT=""
End DoDot:1
+36 SET AF=$ORDER(^PSX(554,"AS",""))
if $GET(AF)'>0
SET AFNS=1
Begin DoDot:1
+37 if $GET(AFNS)=1
QUIT
+38 SET ZTSK=$PIECE(^PSX(554,1,1,AF,0),"^",3)
SET AF=$$FMTE^XLFDT($PIECE(^PSX(554,1,1,AF,0),"^",9))
DO ISQED^%ZTLOAD
if $GET(ZTSK(0))=0!($GET(ZTSK(0))=1)
SET ANXT=$$FMTE^XLFDT($$HTFM^XLFDT($GET(ZTSK("D"))))
+39 SET ARF=$PIECE(AF,",",1)_"@"_$PIECE($PIECE(AF,"@",2),":",1,2)
SET AFNXT=$PIECE(ANXT,",",1)_"@"_$PIECE($PIECE(ANXT,"@",2),":",1,2)
if $GET(AF)=""
SET ARF=""
if $GET(ANXT)=""
SET AFNXT=""
End DoDot:1
+40 SET X1=(18-$LENGTH(PSX1))
SET X2=(23-$LENGTH(SITE))
SET X3=$SELECT($GET(QFLG)=0:(17-$LENGTH(QRY)),1:(18-$LENGTH((QRY-1))))
SET X4=(18-$LENGTH(TRX))
SET TRX=TRX_" Rx's"
SET X5=(23-$LENGTH(TRX))
SET X6=(18-$LENGTH(BCNT))
+41 FOR I=1:1:X1
SET SP=$GET(SP)_"."
+42 FOR J=1:1:X2
SET SP1=$GET(SP1)_"."
+43 FOR K=1:1:X3
SET SP2=$GET(SP2)_"."
+44 FOR M=1:1:X4
SET SP3=$GET(SP3)_"."
+45 FOR L=1:1:X5
SET SP5=$GET(SP5)_"."
+46 FOR N=1:1:X6
SET SP6=$GET(SP6)_"."
+47 FOR O=1:1:77
SET PSXTXT3=$GET(PSXTXT3)_"*"
+48 SET SP4="..........."
SET PSXTXT1="*****Release Data Acknowledgements > 24 hours OUTSTANDING*****"
SET PSXTXT2="*****Rejected Orders OUTSTANDING*****"
+49 KILL I,J,K,M,L,N,O
+50 SET END=1
+51 DO RPT
if $GET(PSXIN)=1
GOTO ASK
if $GET(PSXIN)'=1
GOTO ASK1
+52 GOTO EXIT
+53 QUIT
ASK READ !,"Enter ""^"" to quit",END:30
if $GET(END)["^"
GOTO EXIT
KILL END
GOTO STATUS
ASK1 SET DIR(0)="E"
DO ^DIR
if $GET(Y)["^"!($GET(DIRUT))!($GET(DIROUT))!($GET(DTOUT))!($GET(DUOUT))
GOTO EXIT
GOTO EXIT
RPT SET PSXTXT="CMOP SYSTEM STATUS"
+1 WRITE !!,?((IOM\2)-($LENGTH(PSXTXT)\2)),PSXTXT
+2 WRITE !!," Interface",?23,": ",$SELECT(PSXSTAT="R":"RUNNING",1:"STOPPED")
+3 if $GET(BCNT)>0
WRITE !!," Transmissions Queued",?23,": ",$GET(BCNT),SP6,"Orders/Rx's: ",$GET(OCNT),"/",$GET(CNT)
+4 if $GET(BCNT)'>0
WRITE !!," Transmissions Queued",?23,": ","Nothing in the Queue"
+5 WRITE !!," Last Order Processed ",?23,": ",$GET(PSX1),$GET(SP),$GET(SITE),$GET(SP1),$GET(ACKTM)
+6 WRITE !!," Last Query Completed",?23,": #",$SELECT($GET(QFLG)=0:$GET(QRY),$GET(QFLG)=1:$GET(QRY)-1,1:""),$GET(SP2),$GET(TRX),$GET(SP5),$GET(QTM)
+7 if $DATA(^PSX(554,"AC"))
WRITE !!,?((IOM\2)-($LENGTH(PSXTXT1)\2)),PSXTXT1
+8 if $DATA(^PSX(552.2,"AR"))
WRITE !!,?((IOM\2)-($LENGTH(PSXTXT2)\2)),PSXTXT2
+9 if ('$DATA(^PSX(552.2,"AR"))&('$DATA(^PSX(554,"AC"))))
WRITE !!," ",PSXTXT3
+10 WRITE !!," Background Process",?43,"Last Ran",?66,"Scheduled For"
+11 WRITE !!," Release Data Filed in Master Database.....",?43,$GET(LRF),SP4,$SELECT($GET(RFNS)=1:"Not Scheduled",1:$GET(RFNXT))
+12 WRITE !," Database Purge............................",?43,$GET(DBF),SP4,$SELECT($GET(DBNS)=1:"Not Scheduled",1:$GET(DBNXT))
+13 WRITE !," Release File Purge........................",?43,$GET(LRFP),SP4,$SELECT($GET(RFPNS)=1:"Not Scheduled",1:$GET(RFPNXT))
+14 WRITE !," Release Acknowledgement File Purge........",?43,$GET(ARF),SP4,$SELECT($GET(AFNS)=1:"Not Scheduled",1:$GET(AFNXT))
+15 QUIT
EXIT KILL 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
+1 KILL 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
+2 QUIT
EDIT ;Enter/Edit site parameters on the CMOP host facility system.
+1 ; setup interagency import parameters
IF $DATA(^XUSEC("PSXDOD",DUZ))
DO EDITDOD^PSXHSYS1
+2 SET (QA,QI)=$PIECE(^PSX(553,1,0),"^",9)
SET QLR=$PIECE(^PSX(553,1,0),"^",8)
if $GET(QI)=""
SET QI=1
if $GET(QLR)'>0
SET QLR=10000
+3 IF $GET(QI)["."
SET LEN=$LENGTH($PIECE(QI,".",2))
if $GET(LEN)=1
SET QI=$GET(QI)_"0"
+4 SET HR=$PIECE(QI,".")_" hr "
SET MIN=(60*($PIECE(QI,".",2)/100))_" min"
if $PIECE(QI,".",2)=""
SET MIN=""
+5 SET QRI=$SELECT($PIECE(QI,".")>0:$GET(HR)_$GET(MIN),1:$GET(MIN))
+6 SET REC=$ORDER(^PSX(554,"AS",""))
IF $GET(REC)>0
SET RAS=$PIECE(^PSX(554,1,1,$GET(REC),0),"^",8)
if $GET(RAS)'>0
SET RAS=10
QRI WRITE !!,"Query Request Interval: ",$GET(QRI),"// "
READ QRYINT:DTIME
+1 if $GET(QRYINT)["^"
GOTO EXIT1
+2 SET QIA=QRYINT
if QRYINT=""
SET QIA=QI
+3 IF $GET(QIA)["."
SET LEN=$LENGTH($PIECE(QIA,".",2))
if $GET(LEN)=1
SET QIA=$GET(QIA)_"0"
+4 SET HR=$PIECE(QIA,".")_" hr "
SET MIN=(60*($PIECE(QIA,".",2)/100))_" min"
if $PIECE(QIA,".",2)=""
SET MIN=""
+5 SET QRIB=$SELECT($PIECE(QIA,".")>0:$GET(HR)_$GET(MIN),1:$GET(MIN))
+6 if $GET(QRIB)
WRITE " ( ",$GET(QRIB),")"
+7 IF $GET(QRYINT)["?"
WRITE !!,"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.",!
GOTO QRI
+8 if $GET(QRYINT)'>0
SET QRYINT=$GET(QA)
+9 SET DR="14///"_$GET(QRYINT)
SET DIE="^PSX(553,"
SET DA=1
+10 LOCK +^PSX(553,1):600
if '$TEST
QUIT
DO ^DIE
LOCK -PSX(553,1)
KILL DA,DR,DIE
+11 if $PIECE(^PSX(553,1,0),"^",9)'=$GET(QRYINT)
GOTO QRI
QLR WRITE !,"Query Limit Request: ",$GET(QLR)," Rx's// "
READ QLIM:DTIME
+1 if $GET(QLIM)["^"
GOTO EXIT1
+2 IF $GET(QLIM)["?"
WRITE !!,"This is the maximum number of Rx's that will be accepted during a query request.",!
GOTO QLR
+3 if $GET(QLIM)=""
SET QLIM=$GET(QLR)
+4 IF $GET(QLIM)'?1.5N
WRITE !,"Enter a numeric value between 1 and 99999."
GOTO QLR
+5 IF $GET(QLIM)'>0&($GET(QLIM)'<99999)
WRITE !,"Enter a numeric value between 1 and 99999."
GOTO QLR
+6 SET $PIECE(^PSX(553,1,0),"^",8)=$GET(QLIM)
+7 if $GET(RAS)=""
GOTO EXIT1
RAS WRITE !,"Days to Retain Release Summary: ",$GET(RAS)," days// "
READ ACKSUM:DTIME
+1 if $GET(ACKSUM)["^"
GOTO EXIT1
+2 IF $GET(ACKSUM)["?"
WRITE !!,"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.",!
GOTO RAS
+3 if $GET(ACKSUM)=""
SET ACKSUM=$GET(RAS)
+4 IF $GET(ACKSUM)'?1.2N
WRITE !,"Enter a number value between 1 and 10."
GOTO RAS
+5 IF $GET(ACKSUM)>10
WRITE !,"Maximum number of days to keep is 10."
GOTO RAS
+6 IF $GET(ACKSUM)'>0
WRITE !,"Minimum number of days to keep is 1."
GOTO RAS
+7 ;W " ( ",$G(ACKSUM)," )"
+8 if $GET(REC)'>0
SET REC=$ORDER(^PSX(554,"AS",""))
IF $GET(REC)>0
SET $PIECE(^PSX(554,1,1,$GET(REC),0),"^",8)=$GET(ACKSUM)
DRCSTMIS ;edit 554 parameter for "CMOP DRUG Cost Missing" report
+1 KILL DR,DA,DIE
+2 SET DA=1
SET DR=8
SET DIE=554
LOCK +^PSX(554,1):600
if '$TEST
QUIT
DO ^DIE
+3 LOCK -^PSX(554,1)
KILL DA,DR,DIE
EXIT1 KILL QI,QLR,QRI,QRYINT,QRIB,QA,QLIM,QRY,QRYA,RAS,ACKSUM,LEN,REC,HR,MIN,QIA
QUIT
