source: FOIAVistA/tag/r/CMOP-PSX/PSXRCVRY.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: 4.8 KB
Line 
1PSXRCVRY ;BIR/WPB/PDW-CMOP Utility to reset transmissions at remote ;11 Jul 2002
2 ;;2.0;CMOP;**1,3,28,41**;11 Apr 97
3 ;Reference to ^PS(52.5 supported by DBIA #1978
4 ;Reference to ^PSRX( supported by DBIA #1977
5 ;
6EN D SET^PSXSYS
7 N ZTSK S ZTSK=$P(^PSX(550,+PSXSYS,3),"^",2),PSX=+PSXSYS
8 ;
9 Q:$G(PSXSYS)'>0
10 G:$G(ZTSK)'>0 EN1
11 D STAT^%ZTLOAD
12 I ($G(ZTSK(1))=1&($G(ZTSK(2))["Active"))!($G(ZTSK(1))=2&($G(ZTSK(2))["Active")) W !,"There is a transmission in progress, try again later." Q
13EN1 ;I '$G(ARCVRY) W !,"Please wait, checking for data to send."
14 D:'$D(PSXSYS) SET^PSXSYS
15 ;N PSXSYS D SET^PSXSYS Q:$G(PSXSYS)'>0 S PSXSTAT="T" D PSXSTAT^PSXRSYU K PSXSTAT
16 ;S LAST=$P(^PSX(550,PSX,3),"^",1) K ^PSX("CMOP TRAN")
17 ;loop transmissions 550.2 "AQ" for batches started
18 L ^PSX(550.1):30 I '$T W !,"A transmission build is in process, try again later" Q
19 S PSXBAT=0 F S PSXBAT=$O(^PSX(550.2,"AQ",PSXBAT)) Q:PSXBAT'>0 D
20 . D RSTBATCH(PSXBAT),MMSG,CLNRXQUE(PSXBAT),CLOSEBAT,SUSRST
21 Q
22RSTBATCH(PSXBAT) ; given PSXBAT reset RXs into CMOP SUSPENSE, (code also in re-transmit a batch)
23 ; pull, reset RXs from 550.2 RX multiple
24 S PSXBATNM=$$GET1^DIQ(550.2,PSXBAT,.01)
25 I '$D(^PSX(550.2,PSXBAT,15)) D BLDRXM(PSXBAT) ;build RX multiple from 550.1,"C"
26 S PSXTRXDA=0,RXCNT=0 F S PSXTRXDA=$O(^PSX(550.2,PSXBAT,15,PSXTRXDA)) Q:PSXTRXDA'>0 S PSX0=^PSX(550.2,PSXBAT,15,PSXTRXDA,0) D
27 . F YY="RXDA^1","RXFL^2","PSXHOST^4" D PIECE^PSXUTL(PSX0,U,YY)
28 . D RESET^PSXNEW(RXDA,RXFL,PSXBATNM_" Transmission Recovery") ; resets RX 52.5, 52 into CMOP suspense
29 Q
30CLNRXQUE(PSXBAT) ; locate 550.1 entries associated with transmission PSXBAT and remove
31 K DIK,DA N PSXRXQDA
32 S DIK="^PSX(550.1,"
33 S PSXRXQDA=0 F S PSXRXQDA=$O(^PSX(550.1,"C",PSXBAT,PSXRXQDA)) Q:PSXRXQDA'>0 S DA=PSXRXQDA D ^DIK
34 K DIK,DA
35 Q
36EXIT K DFN,PTR,REC,SDT,LAST,PSXBAT,PSXTRNBT,PSXRXQDA,PSXTRXDA,RXDA,RXFL
37 Q
38MMSG ;
39 S SITE=$P($G(PSXSYS),"^",3) K PSXTRNBT
40 D GETS^DIQ(550.2,PSXBAT,".01;2;3;4;5;6;17","","PSXTRNBT"),TOP^PSXUTL("PSXTRNBT")
41 S XMSUB="CMOP Recovery Message "_$G(SITE),XMDUN="CMOP Managers",XMDUZ=.5
42 D XMZ^XMA2 G:$G(XMZ)'>0 EXIT
43 S ^XMB(3.9,XMZ,2,1,0)="The last CMOP transmission did not complete properly. The data for this"
44 S ^XMB(3.9,XMZ,2,2,0)="transmission will be sent to the CMOP during the next transmission for"
45 S ^XMB(3.9,XMZ,2,3,0)="that division."
46 S ^XMB(3.9,XMZ,2,4,0)=""
47 S ^XMB(3.9,XMZ,2,5,0)="If you have scheduled auto transmissions for CMOP, please check to see"
48 S ^XMB(3.9,XMZ,2,6,0)="that they are still scheduled for the correct time."
49 S ^XMB(3.9,XMZ,2,7,0)=""
50 S ^XMB(3.9,XMZ,2,8,0)="This message is just a notification that problems were detected with the last"
51 S ^XMB(3.9,XMZ,2,9,0)="transmission and that the data will be sent to the CMOP facility for processing."
52 S ^XMB(3.9,XMZ,2,10,0)="If you are getting this message frequently, please contact your IRM staff."
53 S ^XMB(3.9,XMZ,2,11,0)="Otherwise there is not anything that you need to do."
54 S ^XMB(3.9,XMZ,2,12,0)=" "
55 S ^XMB(3.9,XMZ,2,13,0)="Transmission: "_PSXTRNBT(.01)
56 S ^XMB(3.9,XMZ,2,14,0)="Division: "_PSXTRNBT(2)
57 S ^XMB(3.9,XMZ,2,15,0)="CMOP Host: "_PSXTRNBT(3)
58 S ^XMB(3.9,XMZ,2,16,0)="Type: "_PSXTRNBT(17)
59 S ^XMB(3.9,XMZ,2,17,0)="Date/Time: "_PSXTRNBT(5)
60 S ^XMB(3.9,XMZ,2,18,0)=" "
61 S ^XMB(3.9,XMZ,2,19,0)="The prescriptions have been reset into CMOP suspense"
62 S ^XMB(3.9,XMZ,2,20,0)="and this transmission has been closed"
63 S ^XMB(3.9,XMZ,2,0)="^3.92A^20^20^"_DT
64 D GRP^PSXNOTE
65 D ENT1^XMD
66 K XMSUB,XMDUZ,XMDUN,XMZ,XMY,SITE,BADBAT
67 Q
68CLOSEBAT ; close failed transmission PSXBAT in 550.2
69 K DIE,DA,DR
70 S DIE="^PSX(550.2,",DA=PSXBAT,DR="1////4" D ^DIE
71 K DIE,DA,DR
72 Q
73SUSRST ; reset any RXs in suspense with 'L'oading status
74 F RXTYP="N","C" F STAT="L" I $D(^PS(52.5,"CMP",STAT,RXTYP)) S DIV=0 F S DIV=$O(^PS(52.5,"CMP",STAT,RXTYP,DIV)) Q:DIV'>0 D
75 . S SUSDT=0 F S SUSDT=$O(^PS(52.5,"CMP",STAT,RXTYP,DIV,SUSDT)) Q:SUSDT'>0 D DFN
76 Q
77DFN S DFN=0 F S DFN=$O(^PS(52.5,"CMP",STAT,RXTYP,DIV,SUSDT,DFN)) Q:DFN'>0 D
78 . S SUSDA=0 F S SUSDA=$O(^PS(52.5,"CMP",STAT,RXTYP,DIV,SUSDT,DFN,SUSDA)) Q:SUSDA'>0 D SUSRX
79 Q
80SUSRX ; reset suspense RX
81 S SUSRX=$P(^PS(52.5,SUSDA,0),U)
82 D RESET^PSXNEW(SUSRX,0,"Recovery")
83 Q
84BLDRXM(PSXBAT) ; build 550.2 RX multiple from 550.1,"C" given PSXBAT batch ien
85 ; can be used for postinit
86 S ORD=0 F S ORD=$O(^PSX(550.1,"C",PSXBAT,ORD)) Q:ORD'>0 D
87 . S LN=0 F S LN=$O(^PSX(550.1,ORD,"T",LN)) Q:LN'>0 S TXT=^(LN,0) I $P(TXT,"|")="RX1" D
88 .. S RX=$P(TXT,"|",2),RXF=$P(RX,"-",3)-1,RX=$P(RX,"-",2),PSXPTR=$O(^PSRX("B",RX,0))
89 .. S DFN=$P(^PSRX(PSXPTR,0),U,2),REC=$O(^PS(52.5,"B",PSXPTR,0))
90 .. K DD,DO,DIC,DA,DR,D0
91 .. S:'$D(^PSX(550.2,PSXBAT,15,0)) ^PSX(550.2,PSXBAT,15,0)="^550.215P^^"
92 .. S X=RX,DA(1)=PSXBAT
93 .. S DIC="^PSX(550.2,"_PSXBAT_",15,",DIC(0)="LX",DLAYGO=550.2
94 .. S DIC("DR")=".02////^S X=RXF;.03////^S X=DFN;.04////^S X=REC"
95 .. D ^DIC
96 .. K DD,DO,DIC,DA,DR,D0
97 Q
Note: See TracBrowser for help on using the repository browser.