source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGJCSUB.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1RGJCSUB ;SF/JC-MPI/PD SUBSCRIPTION GENERATOR ;04/30/97
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,19,27**;30 Apr 99
3EQ(RGEV,RGSTUB,RGERR,RGEP) ;Entry point for Event Queue Processor
4 S FLL=$P(RGSTUB,U),TLL=$P(RGSTUB,U,2),ICN=$P(RGSTUB,U,3)
5 S PN=$P(RGSTUB,U,4),TP=$P(RGSTUB,U,5),AD=$P(RGSTUB,U,6)
6 S TD=$P(RGSTUB,U,7)
7 I FLL=""!(TLL="")!(ICN="")!(PN="")!(TP="") S RGERR="REQUIRED PARAMETERS MISSING IN STUB"
8 I AD="" S AD=$$NOW^XLFDT,AD=$$DTFH^RGHLUT(AD,1) ;activation date
9 D BM(FLL,TLL,ICN,PN,TP,AD,TD)
10 Q
11BM(FLL,TLL,ICN,PN,TP,AD,TD) ;Build Subscription Request Message
12 ;FLL-'FROM' LOGICAL LINK NAME
13 ;TLL-'TO' LOGICAL LINK NAME
14 ;ICN-PATIENT ID
15 ;PN-PATIENT NAME
16 ;TP-SUBSCRIPTION TYPE
17 ;AD-ACTIVATION DATE HL7 FORMAT
18 ;TD-TERMINATION DATE HL7 FORMAT-OPTIONAL
19 N RGCMOR,RGDFN,RGSSN
20 Q:'+ICN
21 S RGDFN=$$GETDFN^MPIF001(+ICN) Q:+RGDFN<1
22 S RGSSN=$P(^DPT(RGDFN,0),U,9)
23 ;Get institution number of CMOR
24 S RGCMOR=$$GETVCCI^MPIF001(RGDFN)
25 N RGCS,RGRC,RGEC,RGSS,HL
26 D INIT^HLFNC2("RG PT SUBSCRIPTION REQUEST",.HL) Q:+$G(HL)
27 S HLL("LINKS",1)="RG PT SUBSCRIPTION RECEIVER^"_TLL
28 S RGCS=$E(HL("ECH"),1) ;Component
29 S RGRC=$E(HL("ECH"),2) ;Repitition
30 S RGEC=$E(HL("ECH"),3) ;Escape
31 S RGSS=$E(HL("ECH"),4) ;Sub-component separator
32MFI ;MFI-master file identifier segment
33 N X,HLA S X=""
34 S $P(X,HL("FS"))="MFI"
35 S $P(X,HL("FS"),2)="774"_RGCS_"SUBSCRIPTION REGISTRY"_RGCS_"L"
36 S $P(X,HL("FS"),4)="UPD"
37 S $P(X,HL("FS"),7)="NE"
38 S HLA("HLS",1)=X
39MFE ;MFE-master file entry segment
40 S X=""
41 S $P(X,HL("FS"))="MFE"
42 S $P(X,HL("FS"),2)="MUP",$P(X,HL("FS"),4)=AD
43 S $P(X,HL("FS"),5)=+ICN_RGSS_RGSSN_RGSS_2_RGCS_PN_RGCS_"L"
44 S HLA("HLS",2)=X
45DATA ;Record level data in 'ZSD' SEGMENT
46 S HLA("HLS",3)="ZSD"_HL("FS")_FLL_HL("FS")_TP_HL("FS")_AD_HL("FS")_$G(TD)_HL("FS")_HL("FS")_RGCMOR
47SEND ;SEND TO HL7 PACKAGE
48 N HLRST
49 D GENERATE^HLMA("RG PT SUBSCRIPTION REQUEST","LM",1,.HLRST,"",.HL)
50 Q
51ROUTE ;routing logic-parse A04 and put new message on event queue
52 ;to primary facility
53 ;If triggered by an A04
54 ;I $G(HL("ETN"))'="A04" Q
55 ;WITH NEW MESSAGING SUBSCRIPTIONS ARE NO LONGER USED
56 Q
57 K RGLL D R1
58 K RGVCCI,RGVCCIN,RGVCCIS
59 Q
60R1 ;A04
61 N RGI,RGFS,RGLOC,RGLOCIEN,RGLOCNM,RGLOCSN,RGPN,RGSN,RGS,RGSCN,RGTP,RGTO
62 S RGS="",RGFS=HL("FS")
63 F RGI=1:1 X HLNEXT Q:HLQUIT'>0 Q:$P(HLNODE,HL("FS"))="PID"
64 Q:HLQUIT'>0
65 S RGICN=+$P(HLNODE,HL("FS"),3)
66 Q:'RGICN
67 S RGDFN=+$$GETDFN^MPIF001(RGICN)
68 Q:RGDFN'>0
69 S RGVCCI=$$GETVCCI^MPIF001(RGDFN)
70 Q:RGVCCI<1
71 ;fix TS need IEN for compare not sta. num.
72 S RGVCCI=$$LKUP^XUAF4(RGVCCI)
73 I RGVCCI="" D START^RGHLLOG(HLMTIEN),EXC^RGHLLOG(229,"MSG#"_$G(HLMID)_" Unable to send Subscription. Duplicate station number of "_$$GETVCCI^MPIF001(RGDFN)_" in Institution file.",RGDFN) D STOP^RGHLLOG() Q
74 S RGPN=$P(^DPT(RGDFN,0),U) Q:RGPN=""
75 S RGTP=1 ;clinical update
76 S RGAD=$$NOW^XLFDT,RGAD=$$DTFH^RGHLUT(RGAD,1) ;activation date
77 ;Local Station information
78 S RGLOC=$$SITE^VASITE(),RGLOCIEN=$P(RGLOC,U,1),RGLOCNM=$P(RGLOC,U,2),RGLOCSN=$P(RGLOC,U,3)
79 I RGVCCI=RGLOCIEN D ;current site is owner site, update existing subscribers
80 .S RGSCN=$$GETSCN^RGJCREC(RGDFN) ;get SCN
81 .D LINK^HLUTIL3(RGLOCIEN,.RGFROM) ;get local link definition
82 .S RGLL=$O(RGFROM(0)) Q:RGLL="" S RGLL=RGFROM(RGLL)
83 .D REC1^RGJCREC
84 I RGVCCI'=RGLOCIEN D ;current site is not owner, update only owner
85 .D LINK^HLUTIL3(RGLOCIEN,.RGFROM) ;Local Link
86 .S RGFROM=$O(RGFROM(0)) Q:RGFROM="" S RGFROM=RGFROM(RGFROM) ;sending facility
87 .I $E(RGFROM,1,2)'="VA" D START^RGHLLOG(HLMTIEN),EXC^RGHLLOG(224,"MSG#"_$G(HLMID)_" Unable to send Subscription from "_RGFROM_". This is not a MPI/PD Site.",RGDFN) D STOP^RGHLLOG() Q
88 .D LINK^HLUTIL3(RGVCCI,.RGTO) ;get VCCI Link
89 .S RGTO=$O(RGTO(0)) Q:RGTO=""
90 .S RGTO=RGTO(RGTO) ;receiving facility
91 .I $E(RGTO,1,2)'="VA" D START^RGHLLOG(HLMTIEN),EXC^RGHLLOG(224,"MSG#"_$G(HLMID)_" Unable to send Subscription to "_RGTO_". This is not a MPI/PD Site.",RGDFN) D STOP^RGHLLOG() Q
92 .Q:RGTO=RGFROM
93 .S RGSTUB=RGFROM_U_RGTO_U_RGICN_U_RGPN_U_RGTP_U_RGAD
94 .D EN^RGEQ("SCN_REQ",RGSTUB)
Note: See TracBrowser for help on using the repository browser.