source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGMTSTAT.m@ 1394

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

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1RGMTSTAT ;BIR/DLR,CML,PTD-MPI/PD Maintenance Query ;07/30/02
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**20**;30 Apr 99
3 ;
4 ;Reference to ^ORD(101 supported by IA #2596
5 ;
6 Q
7PROCESS ;Processor of QRY msg from protocol, RGMT DEFERRED QRY CLIENT.
8 S RGMT=0 N REP,SG,HLP,HLRESLTA K ^TMP("HLA",$J)
9 F RGMT=1:1 X HLNEXT Q:HLQUIT'>0 S SG=$E(HLNODE,1,3) D:$T(@SG)]"" @SG
10 ;;Queue the deferred status acknowledgment off
11 S RGMTER=$$RESP() I RGMTER'>0 S HLP("ERRTEXT")="Unable to queue query"
12 S ^TMP("HLA",$J,1)="MSA"_HL("FS")_$S(RGMTER>0:"AA",1:"AE")_HL("FS")_HL("MID")
13 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA,"",.HLP)
14 K RGMTER,RGMTID,RGCOMP,SITE,RGMTFS,RGMTRCV,RGMTQRD,^TMP("HLA",$J)
15 Q
16MSH ;process MSH segment
17 S RGMTFS=HL("FS")
18 S RGMTID=HL("MID")
19 S RGCOMP=$E(HL("ECH"),1)
20 S REP=$E(HL("ECH"),2)
21 S SITE=$$LKUP^XUAF4($P($P(HLNODE,HL("FS"),4),RGCOMP))
22 S ZTSAVE("RGMTID")=""
23 S ZTSAVE("RGCOMP")=""
24 S ZTSAVE("SITE")=""
25 S ZTSAVE("RGMTFS")=""
26 S ZTSAVE("REP")=""
27 Q
28QRD ;process QRD segment
29 S RGMTQRD=HLNODE
30 S RGMTRCV=$P(RGMTQRD,HL("FS"),5)
31 S ZTSAVE("RGMTRCV")=""
32 S ZTSAVE("RGMTQRD")=""
33 Q
34STATUS ;processor of QRY acknowledgments, QCK and DSR, from protocol, RGMT DEFERRED QRY SERVER.
35 ;if ack msg type is returned the protocols are not installed
36 I HL("MTN")="QCK" D
37 .S RGMT=0
38 .F RGMT=1:1 X HLNEXT Q:HLQUIT'>0 S SG=$E(HLNODE,1,3) D:$T(@SG)]"" @SG
39 .S $P(^XTMP("RGMT","RGHLMQ",SITE,0),"^",2)="AA"
40 ;the "DSR" ack type should use protocol, RGMT DEFERRED QRY RESPONSE SERVER, if not call its entry point ACK
41 I HL("MTN")="DSR" D ACK
42 Q
43BLD(RGMT) ;Build Query message
44 S DIC="^ORD(101,",X=RGMT D ^DIC K DIC S EID=+Y I EID<0 S EID=""
45 S HL="HL",INT=0
46 W !,EID Q:EID="" -1
47 D INIT^HLFNC2(EID,.HL,INT)
48 S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4),REP=$E(HL("ECH"),2)
49 Q +$G(EID)
50ROUTE ;Generate recipient list/route QRY msg using protocol, RGMT DEFERRED QRY CLIENT.
51 N CLIENT
52 K RGMT
53 S CLIENT="RGMT DEFERRED QRY CLIENT"
54 D LINK^HLUTIL3(SITE,.RGMT)
55 I $O(RGMT(0)) S HLL("LINKS",1)=CLIENT_"^"_$P(RGMT($O(RGMT(0))),U)
56 K RGMT
57 Q
58GEN ;generate hl7 message
59 N HLRESLT,HLP
60 D GENERATE^HLMA(EID,"GM",1,.HLRESLT,"",.HLP)
61 Q
62RESP() ;response to remote query
63 N ZTSK,ZTRTN,ZTDESC,ZTREQ,ZTIO,ZTDTH
64 S ZTREQ="@",ZTDTH=$$NOW^XLFDT,ZTIO="",ZTRTN="DSR^RGMTSTAT",ZTDESC="RGMT QUERY RESP" D ^%ZTLOAD D ^%ZISC
65 Q $G(ZTSK)
66DSRTYPE S RGMTCNT=3
67 F RGMTPC=1:1:$L(RGMTQRD,REP) S RGMTTYP=$P($P(RGMTQRD,RGMTFS,10),REP,RGMTPC) D
68 .S RGDSPCNT=1,RGMT1=0
69 .S RGMT1="" F S RGMT1=$O(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1)) Q:RGMT1="" D
70 ..I $G(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1))'="" S ^TMP("HLS",$J,RGMTCNT)="DSP"_RGMTFS_RGDSPCNT_RGMTFS_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1)_COMP_RGMT1 D
71 ...S RGMTCNT=$G(RGMTCNT)+1,RGDSPCNT=RGDSPCNT+1 Q
72 ..S RGMT2="" F S RGMT2=$O(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2)) Q:RGMT2="" D
73 ...I $G(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2))'="" S ^TMP("HLS",$J,RGMTCNT)="DSP"_HL("FS")_RGDSPCNT_HL("FS")_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2)_COMP_RGMT1_COMP_RGMT2 D
74 ....S RGMTCNT=$G(RGMTCNT)+1,RGDSPCNT=RGDSPCNT+1 Q
75 ...S RGMT3="" F S RGMT3=$O(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3)) Q:RGMT3="" D
76 ....I $G(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3))'="" D
77 .....S ^TMP("HLS",$J,RGMTCNT)="DSP"_HL("FS")_RGDSPCNT_HL("FS")_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3)_COMP_RGMT1_COMP_RGMT2_COMP_RGMT3
78 .....S RGMTCNT=$G(RGMTCNT)+1,RGDSPCNT=RGDSPCNT+1
79 ....S RGMT4="" F S RGMT4=$O(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3,RGMT4)) Q:RGMT4="" D
80 .....I $G(^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3,RGMT4))'="" D
81 ......S ^TMP("HLS",$J,RGMTCNT)="DSP"_HL("FS")_RGDSPCNT_HL("FS")_RGMTPC_HL("FS")_^XTMP("RGMT","HLMQ"_RGMTTYP,RGMTFAC,RGMT1,RGMT2,RGMT3,RGMT4)_COMP_RGMT1_COMP_RGMT2_COMP_RGMT3_COMP_RGMT4
82 ......S RGMTCNT=$G(RGMTCNT)+1,RGDSPCNT=RGDSPCNT+1
83 K ^XTMP("RGMT","HLMQMONT"),^XTMP("RGMT","HLMQHLMA"),^XTMP("RGMT","HLMQETOT")
84 Q
85DSR ;response to remote query
86 N EID,INT,COMP,RGMT,RGMT1,RGMT2,RGMT3,RGMT4,RGMTPC,RGMTTYP,RGMTFAC,RGMTCNT,RGDSPCNT,RGHLMQ
87 K ^TMP("HLS",$J),^XTMP("RGMT","HLMQMONT"),^XTMP("RGMT","HLMQHLMA"),^XTMP("RGMT","HLMQETOT")
88 S COMP=RGCOMP
89 S RGMTFAC=$P($$SITE^VASITE,"^",3)
90 F RGMTPC=1:1:$L($P(RGMTQRD,RGMTFS,10),REP) S RGMTTYP=$P($P(RGMTQRD,RGMTFS,10),REP,RGMTPC) D
91 .S RGHLMQ=1 I RGMTTYP="MONT" D EN2^RGMTMONT
92 .S RGHLMQ=1 I RGMTTYP="HLMA" D HLMA2^RGMTUT98
93 .S RGHLMQ=1 I RGMTTYP="UT01" D EN2^RGMTUT01
94 .S RGMTHQ=1 I RGMTTYP="ETOT" D DUMP2^RGMTETOT D
95 ..S ^XTMP("RGMT","HLMQETOT",RGMTFAC,"@@RUNDATE")=$P($$SITE^VASITE,"^",2)_"^"_$$HTE^XLFDT($H)
96 S RGMT="RGMT DEFERRED QRY RESP SERVER"
97 I $$BLD(RGMT)'>0 S HLP("ERRTEXT")="Could not find protocol" Q
98 S ^TMP("HLS",$J,1)="MSA"_HL("FS")_"AA"_HL("FS")_RGMTID
99 S ^TMP("HLS",$J,2)=RGMTQRD
100 D DSRTYPE
101 D GEN
102 K RGMTQRD,REP,ZTSAVE,RGMTRCV,RGMTMID,SITE,RGMTFS,RGCOMP,SUBCOMP,X,Y
103 Q
104RTERSP ;router for DSR msg from protocol, RGMT DEFERRED QRY RESP SERVER.
105 N CLIENT,SITE
106 S CLIENT="RGMT DEFERRED QRY RESP CLIENT"
107 S SITE=$$LKUP^XUAF4("200M")
108 D LINK^HLUTIL3(SITE,.RGMT)
109 I $O(RGMT(0)) S HLL("LINKS",1)=CLIENT_"^"_$P(RGMT($O(RGMT(0))),U)
110 Q
111ACK ;processor of DSR msg should be using protocol, RGMT DEFERRED QRY RESP CLIENT,
112 ;but is using the originating QRY protocol, RGMT DEFERRED QRY CLIENT.
113 S RGMT=0 K ^TMP("HLA",$J)
114 F RGMT=1:1 X HLNEXT Q:HLQUIT'>0 S SG=$E(HLNODE,1,3) D:$T(@SG)]"" @SG
115 S ^TMP("HLA",$J,1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")
116 N HLRESLTA,HLP D GENACK^HLMA1(HL("EID"),HL("EIDS"),"GM",1,.HLRESLTA,"",.HLP)
117 S $P(^XTMP("RGMT","RGHLMQ",SITE,0),"^",2)="F"
118 K RGMT,RGMTAA
119 Q
120DSP ;display segment
121 N RGMTDSP,RGMTRPT,RGCS,RGDATA,RGNODE
122 S RGDATA=$P(HLNODE,HL("FS"),4,99)
123 S RGMTDSP=$P(HLNODE,HL("FS"),2)
124 S RGMTRPT=$P(HLNODE,HL("FS"),3)
125 I '$D(^XTMP("RGMT","RGHLMQ",SITE,0)) S ^XTMP("RGMT","RGHLMQ",SITE,0)=$$FMADD^XLFDT(DT,7)_"^"_"F"
126 S RGNODE="^XTMP(""RGMT"",""HLMQ"_$S(RGMTRPT=1:"MONT""",RGMTRPT=2:"HLMA""",RGMTRPT=3:"ETOT""",1:"UT01""")_","_SITE
127 F RGCS=2:1:$L(RGDATA,RGCOMP) S RGNODE=RGNODE_","""_$P(RGDATA,RGCOMP,RGCS)_""""
128 S RGNODE=RGNODE_")"
129 I RGNODE["@@ RUNDATE" S @RGNODE=$$GET1^DIQ(4,+SITE_",",.01)_"^"_$P(RGDATA,RGCOMP) Q
130 S @RGNODE=$P(RGDATA,RGCOMP)
131 Q
132MSA ;Message ack segment
133 S RGMTAA=$P(HLNODE,HL("FS"),3)
134 Q
Note: See TracBrowser for help on using the repository browser.