source: FOIAVistA/tag/r/CMOP-PSX/PSXHSYS.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1PSXHSYS ;BIR/WPB/PDW-Displays System Status at CMOP Host Site ;MAR 1,2002@16:11:17
2 ;;2.0;CMOP;**32,38**;11 Apr 97
3STATUS ;display CMOP status for entry action on RX menu
4 G:$G(END) EXIT
5 W @IOF
6 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
7 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
8 N PSXSTAT,PSXTXT
9 S PSXSTAT=$G(^PSX(553,1,"S"))
10 Q:PSXSTAT=""
11 N PSX1,PSX2 S (CNT,BCNT,OCNT,TRX,QFLG,TTRX,DOWN,DORD,DRX,DQRY,DTQRY)=0
12 S QRY=$P(^PSX(553.1,0),"^",3)
13 S STAT=$P(^PSX(553.1,QRY,0),"^",5) D
14 .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
15 .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
16 .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
17 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
18 .S:$G(PSX1)'>0 PSX1="Nothing Downloaded"
19 .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)
20 .S:$G(ACKTM)="" ATM=$$FMTE^XLFDT($P(^PSX(552.1,IN5521,0),"^",6)),ACKTM=$P(ATM,",",1)_"@"_$P($P(ATM,"@",2),":",1,2)
21 I '$D(^PSX(552.1,"AQ")) S CNT=0
22 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
23 .S CNT=$P($G(^PSX(552.1,ZZZ,1)),"^",4)+CNT,OCNT=$P($G(^PSX(552.1,ZZZ,1)),"^",3)+OCNT
24 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
25 .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)
26 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)
27 S RF=$O(^PSX(554,"AB","")) S:$G(RF)'>0 RFNS=1 D
28 .Q:$G(RFNS)=1
29 .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"))))
30 .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=""
31 S DB=$O(^PSX(554,"AD","")) S:$G(DB)'>0 DBNS=1 D
32 .Q:$G(DBNS)=1
33 .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"))))
34 .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=""
35 S RFP=$O(^PSX(554,"AR","")) S:$G(RFP)'>0 RFPNS=1 D
36 .Q:$G(RFPNS)=1
37 .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"))))
38 .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=""
39 S AF=$O(^PSX(554,"AS","")) S:$G(AF)'>0 AFNS=1 D
40 .Q:$G(AFNS)=1
41 .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"))))
42 .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=""
43 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))
44 F I=1:1:X1 S SP=$G(SP)_"."
45 F J=1:1:X2 S SP1=$G(SP1)_"."
46 F K=1:1:X3 S SP2=$G(SP2)_"."
47 F M=1:1:X4 S SP3=$G(SP3)_"."
48 F L=1:1:X5 S SP5=$G(SP5)_"."
49 F N=1:1:X6 S SP6=$G(SP6)_"."
50 F O=1:1:77 S PSXTXT3=$G(PSXTXT3)_"*"
51 S SP4="...........",PSXTXT1="*****Release Data Acknowledgements > 24 hours OUTSTANDING*****",PSXTXT2="*****Rejected Orders OUTSTANDING*****"
52 K I,J,K,M,L,N,O
53 S END=1
54 D RPT G:$G(PSXIN)=1 ASK G:$G(PSXIN)'=1 ASK1
55 G EXIT
56 Q
57ASK R !,"Enter ""^"" to quit",END:30 G:$G(END)["^" EXIT K END G STATUS
58ASK1 S DIR(0)="E" D ^DIR G:$G(Y)["^"!($G(DIRUT))!($G(DIROUT))!($G(DTOUT))!($G(DUOUT)) EXIT G EXIT
59RPT S PSXTXT="CMOP SYSTEM STATUS"
60 W !!,?((IOM\2)-($L(PSXTXT)\2)),PSXTXT
61 W !!," Interface",?23,": ",$S(PSXSTAT="R":"RUNNING",1:"STOPPED")
62 W:$G(BCNT)>0 !!," Transmissions Queued",?23,": ",$G(BCNT),SP6,"Orders/Rx's: ",$G(OCNT),"/",$G(CNT)
63 W:$G(BCNT)'>0 !!," Transmissions Queued",?23,": ","Nothing in the Queue"
64 W !!," Last Order Processed ",?23,": ",$G(PSX1),$G(SP),$G(SITE),$G(SP1),$G(ACKTM)
65 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)
66 W:$D(^PSX(554,"AC")) !!,?((IOM\2)-($L(PSXTXT1)\2)),PSXTXT1
67 W:$D(^PSX(552.2,"AR")) !!,?((IOM\2)-($L(PSXTXT2)\2)),PSXTXT2
68 W:('$D(^PSX(552.2,"AR"))&('$D(^PSX(554,"AC")))) !!," ",PSXTXT3
69 W !!," Background Process",?43,"Last Ran",?66,"Scheduled For"
70 W !!," Release Data Filed in Master Database.....",?43,$G(LRF),SP4,$S($G(RFNS)=1:"Not Scheduled",1:$G(RFNXT))
71 W !," Database Purge............................",?43,$G(DBF),SP4,$S($G(DBNS)=1:"Not Scheduled",1:$G(DBNXT))
72 W !," Release File Purge........................",?43,$G(LRFP),SP4,$S($G(RFPNS)=1:"Not Scheduled",1:$G(RFPNXT))
73 W !," Release Acknowledgement File Purge........",?43,$G(ARF),SP4,$S($G(AFNS)=1:"Not Scheduled",1:$G(AFNXT))
74 Q
75EXIT 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
76 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
77 Q
78EDIT ;Enter/Edit site parameters on the CMOP host facility system.
79 I $D(^XUSEC("PSXDOD",DUZ)) D EDITDOD^PSXHSYS1 ; setup interagency import parameters
80 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
81 I $G(QI)["." S LEN=$L($P(QI,".",2)) S:$G(LEN)=1 QI=$G(QI)_"0"
82 S HR=$P(QI,".")_" hr ",MIN=(60*($P(QI,".",2)/100))_" min" S:$P(QI,".",2)="" MIN=""
83 S QRI=$S($P(QI,".")>0:$G(HR)_$G(MIN),1:$G(MIN))
84 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
85QRI W !!,"Query Request Interval: ",$G(QRI),"// " R QRYINT:DTIME
86 G:$G(QRYINT)["^" EXIT1
87 S QIA=QRYINT S:QRYINT="" QIA=QI
88 I $G(QIA)["." S LEN=$L($P(QIA,".",2)) S:$G(LEN)=1 QIA=$G(QIA)_"0"
89 S HR=$P(QIA,".")_" hr ",MIN=(60*($P(QIA,".",2)/100))_" min" S:$P(QIA,".",2)="" MIN=""
90 S QRIB=$S($P(QIA,".")>0:$G(HR)_$G(MIN),1:$G(MIN))
91 W:$G(QRIB) " ( ",$G(QRIB),")"
92 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
93 S:$G(QRYINT)'>0 QRYINT=$G(QA)
94 S DR="14///"_$G(QRYINT),DIE="^PSX(553,",DA=1
95 L +^PSX(553,1):600 Q:'$T D ^DIE L -PSX(553,1) K DA,DR,DIE
96 G:$P(^PSX(553,1,0),"^",9)'=$G(QRYINT) QRI
97QLR W !,"Query Limit Request: ",$G(QLR)," Rx's// " R QLIM:DTIME
98 G:$G(QLIM)["^" EXIT1
99 I $G(QLIM)["?" W !!,"This is the maximum number of Rx's that will be accepted during a query request.",! G QLR
100 S:$G(QLIM)="" QLIM=$G(QLR)
101 I $G(QLIM)'?1.5N W !,"Enter a numeric value between 1 and 99999." G QLR
102 I $G(QLIM)'>0&($G(QLIM)'<99999) W !,"Enter a numeric value between 1 and 99999." G QLR
103 S $P(^PSX(553,1,0),"^",8)=$G(QLIM)
104 G:$G(RAS)="" EXIT1
105RAS W !,"Days to Retain Release Summary: ",$G(RAS)," days// " R ACKSUM:DTIME
106 G:$G(ACKSUM)["^" EXIT1
107 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
108 S:$G(ACKSUM)="" ACKSUM=$G(RAS)
109 I $G(ACKSUM)'?1.2N W !,"Enter a number value between 1 and 10." G RAS
110 I $G(ACKSUM)>10 W !,"Maximum number of days to keep is 10." G RAS
111 I $G(ACKSUM)'>0 W !,"Minimum number of days to keep is 1." G RAS
112 ;W " ( ",$G(ACKSUM)," )"
113 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)
114DRCSTMIS ;edit 554 parameter for "CMOP DRUG Cost Missing" report
115 K DR,DA,DIE
116 S DA=1,DR=8,DIE=554 L +^PSX(554,1):600 Q:'$T D ^DIE
117 L -^PSX(554,1) K DA,DR,DIE
118EXIT1 K QI,QLR,QRI,QRYINT,QRIB,QA,QLIM,QRY,QRYA,RAS,ACKSUM,LEN,REC,HR,MIN,QIA Q
Note: See TracBrowser for help on using the repository browser.