Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RGJCSUB

RGJCSUB.m

Go to the documentation of this file.
  1. RGJCSUB ;SF/JC-MPI/PD SUBSCRIPTION GENERATOR ;04/30/97
  1. ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,19,27**;30 Apr 99
  1. EQ(RGEV,RGSTUB,RGERR,RGEP) ;Entry point for Event Queue Processor
  1. S FLL=$P(RGSTUB,U),TLL=$P(RGSTUB,U,2),ICN=$P(RGSTUB,U,3)
  1. S PN=$P(RGSTUB,U,4),TP=$P(RGSTUB,U,5),AD=$P(RGSTUB,U,6)
  1. S TD=$P(RGSTUB,U,7)
  1. I FLL=""!(TLL="")!(ICN="")!(PN="")!(TP="") S RGERR="REQUIRED PARAMETERS MISSING IN STUB"
  1. I AD="" S AD=$$NOW^XLFDT,AD=$$DTFH^RGHLUT(AD,1) ;activation date
  1. D BM(FLL,TLL,ICN,PN,TP,AD,TD)
  1. Q
  1. BM(FLL,TLL,ICN,PN,TP,AD,TD) ;Build Subscription Request Message
  1. ;FLL-'FROM' LOGICAL LINK NAME
  1. ;TLL-'TO' LOGICAL LINK NAME
  1. ;ICN-PATIENT ID
  1. ;PN-PATIENT NAME
  1. ;TP-SUBSCRIPTION TYPE
  1. ;AD-ACTIVATION DATE HL7 FORMAT
  1. ;TD-TERMINATION DATE HL7 FORMAT-OPTIONAL
  1. N RGCMOR,RGDFN,RGSSN
  1. Q:'+ICN
  1. S RGDFN=$$GETDFN^MPIF001(+ICN) Q:+RGDFN<1
  1. S RGSSN=$P(^DPT(RGDFN,0),U,9)
  1. ;Get institution number of CMOR
  1. S RGCMOR=$$GETVCCI^MPIF001(RGDFN)
  1. N RGCS,RGRC,RGEC,RGSS,HL
  1. D INIT^HLFNC2("RG PT SUBSCRIPTION REQUEST",.HL) Q:+$G(HL)
  1. S HLL("LINKS",1)="RG PT SUBSCRIPTION RECEIVER^"_TLL
  1. S RGCS=$E(HL("ECH"),1) ;Component
  1. S RGRC=$E(HL("ECH"),2) ;Repitition
  1. S RGEC=$E(HL("ECH"),3) ;Escape
  1. S RGSS=$E(HL("ECH"),4) ;Sub-component separator
  1. MFI ;MFI-master file identifier segment
  1. N X,HLA S X=""
  1. S $P(X,HL("FS"))="MFI"
  1. S $P(X,HL("FS"),2)="774"_RGCS_"SUBSCRIPTION REGISTRY"_RGCS_"L"
  1. S $P(X,HL("FS"),4)="UPD"
  1. S $P(X,HL("FS"),7)="NE"
  1. S HLA("HLS",1)=X
  1. MFE ;MFE-master file entry segment
  1. S X=""
  1. S $P(X,HL("FS"))="MFE"
  1. S $P(X,HL("FS"),2)="MUP",$P(X,HL("FS"),4)=AD
  1. S $P(X,HL("FS"),5)=+ICN_RGSS_RGSSN_RGSS_2_RGCS_PN_RGCS_"L"
  1. S HLA("HLS",2)=X
  1. DATA ;Record level data in 'ZSD' SEGMENT
  1. S HLA("HLS",3)="ZSD"_HL("FS")_FLL_HL("FS")_TP_HL("FS")_AD_HL("FS")_$G(TD)_HL("FS")_HL("FS")_RGCMOR
  1. SEND ;SEND TO HL7 PACKAGE
  1. N HLRST
  1. D GENERATE^HLMA("RG PT SUBSCRIPTION REQUEST","LM",1,.HLRST,"",.HL)
  1. Q
  1. ROUTE ;routing logic-parse A04 and put new message on event queue
  1. ;to primary facility
  1. ;If triggered by an A04
  1. ;I $G(HL("ETN"))'="A04" Q
  1. ;WITH NEW MESSAGING SUBSCRIPTIONS ARE NO LONGER USED
  1. Q
  1. K RGLL D R1
  1. K RGVCCI,RGVCCIN,RGVCCIS
  1. Q
  1. R1 ;A04
  1. N RGI,RGFS,RGLOC,RGLOCIEN,RGLOCNM,RGLOCSN,RGPN,RGSN,RGS,RGSCN,RGTP,RGTO
  1. S RGS="",RGFS=HL("FS")
  1. F RGI=1:1 X HLNEXT Q:HLQUIT'>0 Q:$P(HLNODE,HL("FS"))="PID"
  1. Q:HLQUIT'>0
  1. S RGICN=+$P(HLNODE,HL("FS"),3)
  1. Q:'RGICN
  1. S RGDFN=+$$GETDFN^MPIF001(RGICN)
  1. Q:RGDFN'>0
  1. S RGVCCI=$$GETVCCI^MPIF001(RGDFN)
  1. Q:RGVCCI<1
  1. ;fix TS need IEN for compare not sta. num.
  1. S RGVCCI=$$LKUP^XUAF4(RGVCCI)
  1. 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
  1. S RGPN=$P(^DPT(RGDFN,0),U) Q:RGPN=""
  1. S RGTP=1 ;clinical update
  1. S RGAD=$$NOW^XLFDT,RGAD=$$DTFH^RGHLUT(RGAD,1) ;activation date
  1. ;Local Station information
  1. S RGLOC=$$SITE^VASITE(),RGLOCIEN=$P(RGLOC,U,1),RGLOCNM=$P(RGLOC,U,2),RGLOCSN=$P(RGLOC,U,3)
  1. I RGVCCI=RGLOCIEN D ;current site is owner site, update existing subscribers
  1. .S RGSCN=$$GETSCN^RGJCREC(RGDFN) ;get SCN
  1. .D LINK^HLUTIL3(RGLOCIEN,.RGFROM) ;get local link definition
  1. .S RGLL=$O(RGFROM(0)) Q:RGLL="" S RGLL=RGFROM(RGLL)
  1. .D REC1^RGJCREC
  1. I RGVCCI'=RGLOCIEN D ;current site is not owner, update only owner
  1. .D LINK^HLUTIL3(RGLOCIEN,.RGFROM) ;Local Link
  1. .S RGFROM=$O(RGFROM(0)) Q:RGFROM="" S RGFROM=RGFROM(RGFROM) ;sending facility
  1. .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
  1. .D LINK^HLUTIL3(RGVCCI,.RGTO) ;get VCCI Link
  1. .S RGTO=$O(RGTO(0)) Q:RGTO=""
  1. .S RGTO=RGTO(RGTO) ;receiving facility
  1. .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
  1. .Q:RGTO=RGFROM
  1. .S RGSTUB=RGFROM_U_RGTO_U_RGICN_U_RGPN_U_RGTP_U_RGAD
  1. .D EN^RGEQ("SCN_REQ",RGSTUB)