source: FOIAVistA/trunk/r/CMOP-PSX/PSXRXU.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1PSXRXU ;BIR/WPB,HTW,BAB-Remote Facility File Utilities ;14 Dec 2001
2 ;;2.0;CMOP;**3,28,41,57,48**;11 Apr 97
3 ; Reference to ^PS(52.5, supported by DBIA #1978
4 ; Reference to ^PSOHLSN1 supported by DBIA #2385
5 ; Reference to ^PSRX( supported by DBIA #1977
6 ; Reference to ^XTMP("ORLK-" supported by DBIA #4001
7 ; Reference to $$GETNDC^PSONDCUT supported by DBIA #4705
8START ;files transmission data in file 52 52.5 after transmission is sent
9 ; and clear OERR lock ^XTMP("ORLK-"
10 ; setup error trap for updating RXs in 52 & 52.5
11 D
12 . I '$D(^XTMP("PSXAUTOERR")) N $ETRAP,$ESTACK S $ETRAP="D RXERR^PSXRXU"
13 . D START1
14 Q
15START1 ;
16 S PSXNM="",PSXMSG=0
17 F S PSXNM=$O(^PSX(550.2,PSXBAT,15,"C",PSXNM)) Q:PSXNM']"" D
18 . S DFN="" F S DFN=$O(^PSX(550.2,PSXBAT,15,"C",PSXNM,DFN)) Q:DFN'>0 D
19 .. S RX=0,PSXMSG=PSXMSG+1 F S RX=$O(^PSX(550.2,PSXBAT,15,"C",PSXNM,DFN,RX)) Q:RX'>0 D
20 ... S RXF=$O(^PSX(550.2,PSXBAT,15,"C",PSXNM,DFN,RX,0))
21 ... D FILE
22 Q
23F D FILE^DICN
24 Q
25FILE ;files the data in the CMOP event multiple of PSRX(
26 ;update 52, 52.5 called from PSXBLD RX loop
27 S FILL=+RXF
28 S:$G(PSXTDT)="" PSXTDT=$P(^PSX(550.2,PSXBAT,0),"^",6)
29 Q:'$D(^PSRX(RX,0))
30 ;S PSXMSG=$P(^PSX(550.1,XX,0),"^")
31 ; update RX, RX:CMOP multiple
32 ;If Rx status = suspended (5) set to active (0)
33 I $P(^PSRX(RX,"STA"),U,1)=5 S $P(^PSRX(RX,"STA"),U,1)=0
34 D EN^PSOHLSN1(RX,"SC","ZU","Transmitted to CMOP","")
35 S:'$D(^PSRX(RX,4,0)) ^PSRX(RX,4,0)="^52.01DA^^"
36 K DD,DO,DIE,DA,DIC,DR
37 ;VMP OIFO BAY PINES;ELR;PSX*2*57 REMOVE LOCK AND UNLOCK OF PSRX(4
38 ;L +^PSRX(RX,4,0):600 Q:'$T
39 S DA(1)=RX,DIC="^PSRX("_RX_",4,",DIC(0)="Z",X=PSXBAT
40 S DIC("DR")="1////"_$G(PSXMSG)_";2////"_$G(FILL)_";3////0;12///"_$S($$PATCH^XPDUTL("PSO*7.0*148"):$$GETNDC^PSONDCUT(RX,FILL),1:"")
41 D:'$D(^PSRX(RX,4,"B",PSXBAT)) FILE^DICN I 1
42 E S DIE=DIC,DR=DIC("DR"),DA=$O(^PSRX(RX,4,"B",PSXBAT,0)) K DIC D ^DIE
43 K DIC,DA,DR,DIE
44 ;L -^PSRX(RX,4,0)
45 K FAC
46 S FAC=$$GET1^DIQ(550.2,PSXBAT,3)
47 S COM=$S($G(PSXRTRN):"Re-",1:"")_"Transmitted to "_FAC_" CMOP"
48 S:$G(FILL)>5 FILL=$G(FILL)+1
49 S CNT=0 F JJ=0:0 S JJ=$O(^PSRX(RX,"A",JJ)) Q:'JJ S CNT=JJ
50 S CNT=CNT+1,^PSRX(RX,"A",0)="^52.3DA^"_CNT_"^"_CNT
51 ;VMP OIFO BAY PINES;ELR;PSX*2*57 REMOVE LOCK AND UNLOCK OF PSRX
52 ;L +^PSRX(RX):600 Q:'$T
53 S ^PSRX(RX,"A",CNT,0)=PSXTDT_"^B^"_DUZ_"^"_$G(FILL)_"^"_COM
54 ;L -^PSRX(RX)
55 S IN525=$O(^PS(52.5,"B",RX,""))
56 I $G(IN525)]"" K DIE,DA,DR,DIE,DIC S DIE="^PS(52.5,",DR="3////X",DA=IN525 L +^PS(52.5,IN525):600 Q:'$T D ^DIE L -^PS(52.5,IN525) K DA,DIE,DA,IN525
57 K DIE,DR,DA
58 S DA=PSXMSG,DIE="^PSX(550.1,",DR="1////5"
59 L +^PSX(550.1,PSXMSG):600 Q:'$T
60 D ^DIE L -^PSX(550.1,PSXMSG) K DA,DR,DIE
61OERR ;clear ^XTMP("ORLK-" if it is CPRS/CMOP
62 N ORD S ORD=+$P($G(^PSRX(+$G(RX),"OR1")),"^",2)
63 I ORD,$D(^XTMP("ORLK-"_ORD,0)),^XTMP("ORLK-"_ORD,0)["CPRS/CMOP" K ^XTMP("ORLK-"_ORD)
64 Q
65PRINT D NOW^%DTC S DTTM=% S COM="CMOP Suspense Label "_$S($G(^PS(52.5,REC,"P"))=0:"Printed",1:"RePrinted")_$S($G(^PSRX(PTR,"TYPE"))>0:" (PARTIAL)",1:"")
66 S CNT=0 F JJ=0:0 S JJ=$O(^PSRX(PTR,"A",JJ)) Q:'JJ S CNT=JJ
67 S $P(^PSRX(PTR,"STA"),"^",1)=0,^PS(52.5,REC,"P")=1
68 S CNT=CNT+1,^PSRX(PTR,"A",0)="^52.3DA^"_CNT_"^"_CNT L +^PSRX(PTR):600 Q:'$T S ^PSRX(PTR,"A",CNT,0)=DTTM_"^S^"_DUZ_"^"_FILL_"^"_COM L -^PSRX(PTR)
69 K DTTM,%,COM,CNT,JJ
70 Q
71SUSPS ;goes through the PS(550.1 file and gets the pointer for each rx in PSRX
72 ;CMOP Event entry
73 S XXX=0 F S XXX=$O(^PSX(550.1,REC,2,XXX)) Q:XXX'>0 D ACLOG
74 K XXX
75 Q
76ACLOG ;
77 D NOW^%DTC
78 S PSXPTR=$P($G(^PSX(550.1,REC,2,XXX,0)),U,1)
79 F RCC=0:0 S RCC=$O(^PSRX(+PSXPTR,4,"B",OLDBAT,RCC)) Q:RCC="" S RC=RCC
80 S TRNN=$P($G(^PSRX(+PSXPTR,4,RC,0)),"^",1)
81 S FAC=$$GET1^DIQ(550.2,TRNN,3)
82 S FILL=$P($G(^PSRX(+PSXPTR,4,RC,0)),"^",3)
83 S CNT=0 F JJ=0:0 S JJ=$O(^PSRX(+PSXPTR,"A",JJ)) Q:'JJ S CNT=JJ
84 S COMMENT="Retransmitted to "_FAC_" CMOP"
85 S CNT=CNT+1,^PSRX(+PSXPTR,"A",0)="^52.3DA^"_CNT_"^"_CNT
86 L +^PSRX(+PSXPTR):600 Q:'$T
87 S ^PSRX(+PSXPTR,"A",CNT,0)=%_U_"B"_U_DUZ_U_$S(FILL>5:(FILL+1),1:FILL)_U_COMMENT
88 L -^PSRX(+PSXPTR)
89 L +^PSRX(+PSXPTR,4,0):600 Q:'$T
90 S DA(1)=+PSXPTR,DIE="^PSRX("_+PSXPTR_",4,",DA=RC,DR="3////2"
91 D ^DIE K DIE,DA,DR,DD,DO
92 S:'$D(^PSRX(+PSXPTR,4,0)) ^PSRX(+PSXPTR,4,0)="^52.01DA^^"
93 S DA(1)=+PSXPTR,DIC="^PSRX("_+PSXPTR_",4,",DIC(0)="Z",X=PSXBAT
94 S DIC("DR")="1////"_REC_";2////"_$G(FILL)_";3////0" D F
95 L -^PSRX(+PSXPTR,4,0)
96 K PSXPTR,COMMENT,CNT,JJ,FILL,REF,%,DIC,DA,DIE,DR
97 S DA=REC,DIE="^PSX(550.1,",DR="1////5" L +^PSX(550.1,REC):600 Q:'$T
98 D ^DIE L -^PSX(550.1,REC) K DIE,DA,DR,FAC,TRNN
99 Q
100RXERR ;auto error processing of RX updating 52 & 52.5
101 S XXERR=$$EC^%ZOSV
102 S PSXDIVNM=$$GET1^DIQ(59,PSOSITE,.01)
103 ;save an image of the transient file 550.1 for 2 days
104 D NOW^%DTC S DTTM=%
105 ;VMP OIFO BAY PINES;ELR;PSX*2*57 CHANE PURGE DATE TO T+12 FROM T+2
106 S X=$$FMADD^XLFDT(DT,+12) S ^XTMP("PSXERR "_DTTM,0)=X_U_DT_U_"CMOP "_XXERR
107 M ^XTMP("PSXERR "_DTTM,550.1)=^PSX(550.1)
108 S XMSUB="CMOP Error "_PSXDIVNM_" "_$$GET1^DIQ(550.2,+$G(PSXBAT),.01)
109 D GRP1^PSXNOTE
110 ;S XMY(DUZ)=""
111 S XMTEXT="TEXT("
112 S TEXT(1,0)=$S($G(PSXCS):"",1:"NON-")_"CS CMOP transmission encountered the following error. Please investigate"
113 S TEXT(2,0)="Division: "_PSXDIVNM
114 S TEXT(3,0)="Type/Batch "_$S($G(PSXCS):"CS",1:"NON-CS")_" / "_$$GET1^DIQ(550.2,$G(PSXBAT),.01)
115 S TEXT(4,0)="Error: "_XXERR
116 S TEXT(5,0)=">>>This batch has been sent <<<"
117 S TEXT(6,0)="Call NVS to investigate which prescriptions have been updated"
118 S TEXT(7,0)="or not updated in files Prescription #52 & Suspense 52.5 ."
119 S TEXT(8,0)="A copy of file 550.1 can be found in ^XTMP(""PSXERR "_DTTM_""")"
120 D ^%ZTER
121 D ^XMD
122 G UNWIND^%ZTER
Note: See TracBrowser for help on using the repository browser.