Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSXHSYS

PSXHSYS.m

Go to the documentation of this file. 
  1. 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
  1. STATUS ;display CMOP status for entry action on RX menu
  1.  G:$G(END) EXIT
  1.  W @IOF
  1.  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
  1.  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
  1.  N PSXSTAT,PSXTXT
  1.  S PSXSTAT=$G(^PSX(553,1,"S"))
  1.  Q:PSXSTAT=""
  1.  N PSX1,PSX2 S (CNT,BCNT,OCNT,TRX,QFLG,TTRX,DOWN,DORD,DRX,DQRY,DTQRY)=0
  1.  S QRY=$P(^PSX(553.1,0),"^",3)
  1.  S STAT=$P(^PSX(553.1,QRY,0),"^",5) D
  1.  .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
  1.  .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
  1.  .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
  1.  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
  1.  .S:$G(PSX1)'>0 PSX1="Nothing Downloaded"
  1.  .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)
  1.  .S:$G(ACKTM)="" ATM=$$FMTE^XLFDT($P(^PSX(552.1,IN5521,0),"^",6)),ACKTM=$P(ATM,",",1)_"@"_$P($P(ATM,"@",2),":",1,2)
  1.  I '$D(^PSX(552.1,"AQ")) S CNT=0
  1.  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
  1.  .S CNT=$P($G(^PSX(552.1,ZZZ,1)),"^",4)+CNT,OCNT=$P($G(^PSX(552.1,ZZZ,1)),"^",3)+OCNT
  1.  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
  1.  .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)
  1.  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)
  1.  S RF=$O(^PSX(554,"AB","")) S:$G(RF)'>0 RFNS=1 D
  1.  .Q:$G(RFNS)=1
  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"))))
  1.  .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=""
  1.  S DB=$O(^PSX(554,"AD","")) S:$G(DB)'>0 DBNS=1 D
  1.  .Q:$G(DBNS)=1
  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"))))
  1.  .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=""
  1.  S RFP=$O(^PSX(554,"AR","")) S:$G(RFP)'>0 RFPNS=1 D
  1.  .Q:$G(RFPNS)=1
  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"))))
  1.  .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=""
  1.  S AF=$O(^PSX(554,"AS","")) S:$G(AF)'>0 AFNS=1 D
  1.  .Q:$G(AFNS)=1
  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"))))
  1.  .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=""
  1.  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))
  1.  F I=1:1:X1 S SP=$G(SP)_"."
  1.  F J=1:1:X2 S SP1=$G(SP1)_"."
  1.  F K=1:1:X3 S SP2=$G(SP2)_"."
  1.  F M=1:1:X4 S SP3=$G(SP3)_"."
  1.  F L=1:1:X5 S SP5=$G(SP5)_"."
  1.  F N=1:1:X6 S SP6=$G(SP6)_"."
  1.  F O=1:1:77 S PSXTXT3=$G(PSXTXT3)_"*"
  1.  S SP4="...........",PSXTXT1="*****Release Data Acknowledgements > 24 hours OUTSTANDING*****",PSXTXT2="*****Rejected Orders OUTSTANDING*****"
  1.  K I,J,K,M,L,N,O
  1.  S END=1
  1.  D RPT G:$G(PSXIN)=1 ASK G:$G(PSXIN)'=1 ASK1
  1.  G EXIT
  1.  Q
  1. ASK R !,"Enter ""^"" to quit",END:30 G:$G(END)["^" EXIT K END G STATUS
  1. ASK1 S DIR(0)="E" D ^DIR G:$G(Y)["^"!($G(DIRUT))!($G(DIROUT))!($G(DTOUT))!($G(DUOUT)) EXIT G EXIT
  1. RPT S PSXTXT="CMOP SYSTEM STATUS"
  1.  W !!,?((IOM\2)-($L(PSXTXT)\2)),PSXTXT
  1.  W !!," Interface",?23,": ",$S(PSXSTAT="R":"RUNNING",1:"STOPPED")
  1.  W:$G(BCNT)>0 !!," Transmissions Queued",?23,": ",$G(BCNT),SP6,"Orders/Rx's: ",$G(OCNT),"/",$G(CNT)
  1.  W:$G(BCNT)'>0 !!," Transmissions Queued",?23,": ","Nothing in the Queue"
  1.  W !!," Last Order Processed ",?23,": ",$G(PSX1),$G(SP),$G(SITE),$G(SP1),$G(ACKTM)
  1.  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)
  1.  W:$D(^PSX(554,"AC")) !!,?((IOM\2)-($L(PSXTXT1)\2)),PSXTXT1
  1.  W:$D(^PSX(552.2,"AR")) !!,?((IOM\2)-($L(PSXTXT2)\2)),PSXTXT2
  1.  W:('$D(^PSX(552.2,"AR"))&('$D(^PSX(554,"AC")))) !!," ",PSXTXT3
  1.  W !!," Background Process",?43,"Last Ran",?66,"Scheduled For"
  1.  W !!," Release Data Filed in Master Database.....",?43,$G(LRF),SP4,$S($G(RFNS)=1:"Not Scheduled",1:$G(RFNXT))
  1.  W !," Database Purge............................",?43,$G(DBF),SP4,$S($G(DBNS)=1:"Not Scheduled",1:$G(DBNXT))
  1.  W !," Release File Purge........................",?43,$G(LRFP),SP4,$S($G(RFPNS)=1:"Not Scheduled",1:$G(RFPNXT))
  1.  W !," Release Acknowledgement File Purge........",?43,$G(ARF),SP4,$S($G(AFNS)=1:"Not Scheduled",1:$G(AFNXT))
  1.  Q
  1. 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
  1.  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
  1.  Q
  1. EDIT ;Enter/Edit site parameters on the CMOP host facility system.
  1.  I $D(^XUSEC("PSXDOD",DUZ)) D EDITDOD^PSXHSYS1 ; setup interagency import parameters
  1.  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
  1.  I $G(QI)["." S LEN=$L($P(QI,".",2)) S:$G(LEN)=1 QI=$G(QI)_"0"
  1.  S HR=$P(QI,".")_" hr ",MIN=(60*($P(QI,".",2)/100))_" min" S:$P(QI,".",2)="" MIN=""
  1.  S QRI=$S($P(QI,".")>0:$G(HR)_$G(MIN),1:$G(MIN))
  1.  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
  1. QRI W !!,"Query Request Interval:  ",$G(QRI),"//  " R QRYINT:DTIME
  1.  G:$G(QRYINT)["^" EXIT1
  1.  S QIA=QRYINT S:QRYINT="" QIA=QI
  1.  I $G(QIA)["." S LEN=$L($P(QIA,".",2)) S:$G(LEN)=1 QIA=$G(QIA)_"0"
  1.  S HR=$P(QIA,".")_" hr ",MIN=(60*($P(QIA,".",2)/100))_" min" S:$P(QIA,".",2)="" MIN=""
  1.  S QRIB=$S($P(QIA,".")>0:$G(HR)_$G(MIN),1:$G(MIN))
  1.  W:$G(QRIB) " ( ",$G(QRIB),")"
  1.  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
  1.  S:$G(QRYINT)'>0 QRYINT=$G(QA)
  1.  S DR="14///"_$G(QRYINT),DIE="^PSX(553,",DA=1
  1.  L +^PSX(553,1):600 Q:'$T  D ^DIE L -PSX(553,1) K DA,DR,DIE
  1.  G:$P(^PSX(553,1,0),"^",9)'=$G(QRYINT) QRI
  1. QLR W !,"Query Limit Request:  ",$G(QLR)," Rx's//  " R QLIM:DTIME
  1.  G:$G(QLIM)["^" EXIT1
  1.  I $G(QLIM)["?" W !!,"This is the maximum number of Rx's that will be accepted during a query request.",! G QLR
  1.  S:$G(QLIM)="" QLIM=$G(QLR)
  1.  I $G(QLIM)'?1.5N W !,"Enter a numeric value between 1 and 99999." G QLR
  1.  I $G(QLIM)'>0&($G(QLIM)'<99999) W !,"Enter a numeric value between 1 and 99999." G QLR
  1.  S $P(^PSX(553,1,0),"^",8)=$G(QLIM)
  1.  G:$G(RAS)="" EXIT1
  1. RAS W !,"Days to Retain Release Summary:  ",$G(RAS)," days//  " R ACKSUM:DTIME
  1.  G:$G(ACKSUM)["^" EXIT1
  1.  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
  1.  S:$G(ACKSUM)="" ACKSUM=$G(RAS)
  1.  I $G(ACKSUM)'?1.2N W !,"Enter a number value between 1 and 10." G RAS
  1.  I $G(ACKSUM)>10 W !,"Maximum number of days to keep is 10." G RAS
  1.  I $G(ACKSUM)'>0 W !,"Minimum number of days to keep is 1." G RAS
  1.  ;W " ( ",$G(ACKSUM)," )"
  1.  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)
  1. DRCSTMIS ;edit 554 parameter for "CMOP DRUG Cost Missing" report
  1.  K DR,DA,DIE
  1.  S DA=1,DR=8,DIE=554 L +^PSX(554,1):600 Q:'$T  D ^DIE
  1.  L -^PSX(554,1) K DA,DR,DIE
  1. EXIT1 K QI,QLR,QRI,QRYINT,QRIB,QA,QLIM,QRY,QRYA,RAS,ACKSUM,LEN,REC,HR,MIN,QIA Q