source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXRTR.m@ 691

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

initial load of WorldVistAEHR
File size: 4.6 KB
Line 
1PSXRTR ;BIR/BAB,WPB,PWC-Transmit Data to CMOP Host System ;14 Dec 2001
2 ;;2.0;CMOP;**18,23,27,31,28,41,51**;11 Apr 97
3 ;Reference to ^DIC(4.2 supported by DBIA #1966
4 ;Reference to ^PS(59 supported by DBIA #1976
5 ;Reference to File #200 supported by DBIA #10060
6 ;Requires PSXHDR,PSXORD (A B C D) arrays
7 Q
8EN ;Entry point for data transmission, load mailman message and send
9 S PSXJOB=1,PSXRTRN=0 K ERR
10 I $E(IOST)="C" W !,"EN^PSXRTR DIV: ",PSOSITE," ",+$G(PSXBAT)
11 I (($G(PSXBAT)="")!('$D(^PSX(550.1,"C",PSXBAT)))) G EXIT
12 S (PSXMSG,PSXMFLAG,PSXEND,PSXSTART)=0
13 F S PSXMSG=$O(^PSX(550.1,"C",PSXBAT,PSXMSG)) Q:PSXMSG'>0 S PSXEND=PSXMSG S:PSXSTART=0 PSXSTART=PSXMSG
14 S PSXSITE=$P($G(PSXSYS),U,3),PSXSENDR=$$GET1^DIQ(200,DUZ,.01),SITENUM=$P($G(PSXSYS),U,2),PSXDIV=$P($G(^PS(59,+PSOSITE,0)),U,1),XSITE=$P($G(^PS(59,+PSOSITE,0)),U,6)
15 S PSXHDR=PSXSITE_U_+PSXSYS_U_SITENUM_U_PSXTDT_U_PSXSENDR_U_PSXSTART_U_PSXEND_U_PSXDIV_U_XSITE,PSXREF=SITENUM_"-"_$$GET1^DIQ(550.2,PSXBAT,.01)
16 N DOMAIN,LCNT,XMDUZ,XMSUB,XMZ,ORD
17 S (LCNT,PSXMSGCT,PSXRXCT)=0
18 S X=$$KSP^XUPARAM("INST"),DIC="4",DIC(0)="XMZO" D ^DIC S SITEX=$P(Y,"^",2) K DIC,X,Y
19 S XMSUB="CMOP"_$S($G(PSXCS)=1:" Controlled Substances",1:"")_" Transmission from "_SITEX,XMDUZ=.5
20XMZ D XMZ^XMA2
21 I XMZ'>0 G XMZ
22 K SITEX
23HDR ;Gather data from header, load NTE1 - NTE5 into mailmessage from PSXORD( array
24 S ORD="$$XMIT"_U_$$GET1^DIQ(550.2,PSXBAT,.01)_U_PSXHDR D TXT
25 S ORD=$G(PSXORD("A")) D TXT
26 ;If not any data in the refill/nonrefill/copay instructions set
27 ;set array equal to NTE...+3 spaces
28 S:$G(PSXORD("B",1))="" PSXORD("B",1)="NTE|2|| "
29 S:$G(PSXORD("C",1))="" PSXORD("C",1)="NTE|3|| "
30 S:$G(PSXORD("D",1))="" PSXORD("D",1)="NTE|4|| "
31 F ZZ="B","C","D" S Z=0 F S Z=$O(PSXORD(ZZ,Z)) Q:Z'>0 S ORD=$G(PSXORD(ZZ,Z)) D TXT
32 ;Gather data for individual patient orders
33LOCK ;
34 D NOW^%DTC S DTTM=%,(MSG,ZCNT)=0
35 ; load patients' 550.1 "T" nodes into the mail message
36 F S MSG=$O(^PSX(550.1,"C",PSXBAT,MSG)) Q:MSG="" S PSXMSGCT=PSXMSGCT+1,LNTX=+$P(^PSX(550.1,MSG,"T",0),U,4) D
37 .S ORD="$MSG^"_+$G(^PSX(550.1,MSG,0))_U_LNTX D TXT
38 .F PSX=1:1:LNTX I $G(^PSX(550.1,MSG,"T",PSX,0))]"" S ORD=$G(^(0)) S:$E(ORD,1,7)="ORC|NW|" PSXRXCT=PSXRXCT+1 D TXT
39 .K DA,DIE,DR S DA=MSG L +^PSX(550.1,DA)
40 .S DIE="^PSX(550.1,",DR="1///2;5////"_DTTM_";3////"_PSXBAT
41 .D ^DIE L -^PSX(550.1,DA) K DA,DIE,DR ;update msgs in 550.1
42 S ORD="$$ENDXMIT^"_U_PSXFAC_U_PSXBAT_U_PSXMSGCT_U_PSXRXCT D TXT K ORD
43 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_U_LCNT_U_DT,XMDUN="CMOP Manager"
44 S XMDUZ=.5
45 S RECV=$P($G(^PSX(550,+PSXSYS,0)),U,4),DOMAIN="@"_$$GET1^DIQ(4.2,RECV,.01)
46 ;code to divert patient transmissions for testing
47 I '$D(^XTMP("PSXDIVERTCMOP")) S XMY("S.PSXX CMOP SERVER"_DOMAIN)="" I 1 ;****TESTING
48 E S XX=^XTMP("PSXDIVERTCMOP",1) S XMY(XX)="" H 1 ;****TESTING S.PSXX
49 D ENT1^XMD
50 D XMIT
51 S PSXFLAG=1 D EN^PSXNOTE
52 K DIE,DA,DR,BAT,PSX,PSXORD,MSG,LNTX,LCNT,DOMAIN,RECV,SITENUM,Z,ZZ,XMDUN,XMDUZ,XMSUB,XMY,XMZ,PSXDIV,XSITE
53 Q
54XMIT ;Update 550.2 # of ORDs, RXs; rxS IN 52, 52.5: 550.2 to Transmitted
55 ;Update 550 with batch
56 N PSXTRDTM D NOW^%DTC S PSXTRDTM=%
57 L +^PSX(550.2,PSXBAT):600 I '$T S XQAMSG="CMOP Transmission file in use. Entry for trans "_PSXBAT_" not complete. Contact IRM." D GRP1^PSXNOTE,SETUP^XQALERT K XQAMSG,XQA Q
58 S DA=PSXBAT,DIE="^PSX(550.2,",DR="1////2;11////"_PSXSTART_";12////"_PSXEND_";13////"_PSXMSGCT_";14////"_PSXRXCT_";5////"_PSXTRDTM
59 D ^DIE K DA,DIE,DR
60 L -^PSX(550.2,PSXBAT)
61 S PSXMFLAG=1
62 D ^PSXRXU ; update RXs in 52 52.5
63 L +^PSX(550,+PSXSYS):600 Q:'$T
64 S DA=+PSXSYS,DIE="^PSX(550,",DR="6////"_PSXBAT D ^DIE K DIE,DA,DR
65 L -^PSX(550,+PSXSYS)
66 Q
67TXT ;
68 I $G(ORD)]"" S LCNT=LCNT+1,^XMB(3.9,XMZ,2,LCNT,0)=ORD
69 Q
70EXIT K %,ERROR,PSXRTRN,PSXJOB,PSXER,PSXHDR,PSXFAC,PSXBAT,PSXEND,PSXMFLAG,PSXMSG,PSXMSGCT,PSXRXCT,PSXSENDR,PSXSITE,PSXTDT,N Q
71 Q
72DIVERT ; divert transmissions from CMOP to the user evoking the divert
73 W !,"This will divert CMOP Patient transmissions to the user evoking the divert",!,"for one day or until 'D RESET^PSXRTR' is executed.",!
74 K DIR S DIR(0)="YO",DIR("B")="N" D ^DIR
75 I 'Y W !,"CMOP Patient transmissions >>NOT DIVERTED<<",! Q
76 S ^XTMP("PSXDIVERTCMOP",0)=DT_U_DT_U_"Divert CMOP Transmissions"
77 S ^XTMP("PSXDIVERTCMOP",1)=DUZ
78 W !!,"CMOP Patient transmissions >>DIVERTED<< to ",$$GET1^DIQ(200,DUZ,.01),!!,"Use 'D RESET^PSXRTR' to restore normal CMOP Patient transmissions.",!
79 K DIR S DIR(0)="E",DIR("A")="<CR> Continue" D ^DIR
80 Q
81RESET ; reset normal CMOP Patient transmissions
82 S XX=$D(^XTMP("PSXDIVERTCMOP"))
83 S N=$S(XX>0:"HAD BEEN",1:"HAD NOT BEEN")
84 W !,"CMOP Patient transmissions >>",N,"<< diverted"
85 I XX S XX=^XTMP("PSXDIVERTCMOP",1) W " to ",$$GET1^DIQ(200,XX,.01)
86 W ".",!,"CMOP Patient transmissions are set to go to the CMOP.",!
87 K ^XTMP("PSXDIVERTCMOP")
88 Q
Note: See TracBrowser for help on using the repository browser.