- RGJCSUB ;SF/JC-MPI/PD SUBSCRIPTION GENERATOR ;04/30/97
- ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,19,27**;30 Apr 99
- EQ(RGEV,RGSTUB,RGERR,RGEP) ;Entry point for Event Queue Processor
- S FLL=$P(RGSTUB,U),TLL=$P(RGSTUB,U,2),ICN=$P(RGSTUB,U,3)
- S PN=$P(RGSTUB,U,4),TP=$P(RGSTUB,U,5),AD=$P(RGSTUB,U,6)
- S TD=$P(RGSTUB,U,7)
- I FLL=""!(TLL="")!(ICN="")!(PN="")!(TP="") S RGERR="REQUIRED PARAMETERS MISSING IN STUB"
- I AD="" S AD=$$NOW^XLFDT,AD=$$DTFH^RGHLUT(AD,1) ;activation date
- D BM(FLL,TLL,ICN,PN,TP,AD,TD)
- Q
- BM(FLL,TLL,ICN,PN,TP,AD,TD) ;Build Subscription Request Message
- ;FLL-'FROM' LOGICAL LINK NAME
- ;TLL-'TO' LOGICAL LINK NAME
- ;ICN-PATIENT ID
- ;PN-PATIENT NAME
- ;TP-SUBSCRIPTION TYPE
- ;AD-ACTIVATION DATE HL7 FORMAT
- ;TD-TERMINATION DATE HL7 FORMAT-OPTIONAL
- N RGCMOR,RGDFN,RGSSN
- Q:'+ICN
- S RGDFN=$$GETDFN^MPIF001(+ICN) Q:+RGDFN<1
- S RGSSN=$P(^DPT(RGDFN,0),U,9)
- ;Get institution number of CMOR
- S RGCMOR=$$GETVCCI^MPIF001(RGDFN)
- N RGCS,RGRC,RGEC,RGSS,HL
- D INIT^HLFNC2("RG PT SUBSCRIPTION REQUEST",.HL) Q:+$G(HL)
- S HLL("LINKS",1)="RG PT SUBSCRIPTION RECEIVER^"_TLL
- S RGCS=$E(HL("ECH"),1) ;Component
- S RGRC=$E(HL("ECH"),2) ;Repitition
- S RGEC=$E(HL("ECH"),3) ;Escape
- S RGSS=$E(HL("ECH"),4) ;Sub-component separator
- MFI ;MFI-master file identifier segment
- N X,HLA S X=""
- S $P(X,HL("FS"))="MFI"
- S $P(X,HL("FS"),2)="774"_RGCS_"SUBSCRIPTION REGISTRY"_RGCS_"L"
- S $P(X,HL("FS"),4)="UPD"
- S $P(X,HL("FS"),7)="NE"
- S HLA("HLS",1)=X
- MFE ;MFE-master file entry segment
- S X=""
- S $P(X,HL("FS"))="MFE"
- S $P(X,HL("FS"),2)="MUP",$P(X,HL("FS"),4)=AD
- S $P(X,HL("FS"),5)=+ICN_RGSS_RGSSN_RGSS_2_RGCS_PN_RGCS_"L"
- S HLA("HLS",2)=X
- DATA ;Record level data in 'ZSD' SEGMENT
- S HLA("HLS",3)="ZSD"_HL("FS")_FLL_HL("FS")_TP_HL("FS")_AD_HL("FS")_$G(TD)_HL("FS")_HL("FS")_RGCMOR
- SEND ;SEND TO HL7 PACKAGE
- N HLRST
- D GENERATE^HLMA("RG PT SUBSCRIPTION REQUEST","LM",1,.HLRST,"",.HL)
- Q
- ROUTE ;routing logic-parse A04 and put new message on event queue
- ;to primary facility
- ;If triggered by an A04
- ;I $G(HL("ETN"))'="A04" Q
- ;WITH NEW MESSAGING SUBSCRIPTIONS ARE NO LONGER USED
- Q
- K RGLL D R1
- K RGVCCI,RGVCCIN,RGVCCIS
- Q
- R1 ;A04
- N RGI,RGFS,RGLOC,RGLOCIEN,RGLOCNM,RGLOCSN,RGPN,RGSN,RGS,RGSCN,RGTP,RGTO
- S RGS="",RGFS=HL("FS")
- F RGI=1:1 X HLNEXT Q:HLQUIT'>0 Q:$P(HLNODE,HL("FS"))="PID"
- Q:HLQUIT'>0
- S RGICN=+$P(HLNODE,HL("FS"),3)
- Q:'RGICN
- S RGDFN=+$$GETDFN^MPIF001(RGICN)
- Q:RGDFN'>0
- S RGVCCI=$$GETVCCI^MPIF001(RGDFN)
- Q:RGVCCI<1
- ;fix TS need IEN for compare not sta. num.
- S RGVCCI=$$LKUP^XUAF4(RGVCCI)
- 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
- S RGPN=$P(^DPT(RGDFN,0),U) Q:RGPN=""
- S RGTP=1 ;clinical update
- S RGAD=$$NOW^XLFDT,RGAD=$$DTFH^RGHLUT(RGAD,1) ;activation date
- ;Local Station information
- S RGLOC=$$SITE^VASITE(),RGLOCIEN=$P(RGLOC,U,1),RGLOCNM=$P(RGLOC,U,2),RGLOCSN=$P(RGLOC,U,3)
- I RGVCCI=RGLOCIEN D ;current site is owner site, update existing subscribers
- .S RGSCN=$$GETSCN^RGJCREC(RGDFN) ;get SCN
- .D LINK^HLUTIL3(RGLOCIEN,.RGFROM) ;get local link definition
- .S RGLL=$O(RGFROM(0)) Q:RGLL="" S RGLL=RGFROM(RGLL)
- .D REC1^RGJCREC
- I RGVCCI'=RGLOCIEN D ;current site is not owner, update only owner
- .D LINK^HLUTIL3(RGLOCIEN,.RGFROM) ;Local Link
- .S RGFROM=$O(RGFROM(0)) Q:RGFROM="" S RGFROM=RGFROM(RGFROM) ;sending facility
- .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
- .D LINK^HLUTIL3(RGVCCI,.RGTO) ;get VCCI Link
- .S RGTO=$O(RGTO(0)) Q:RGTO=""
- .S RGTO=RGTO(RGTO) ;receiving facility
- .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
- .Q:RGTO=RGFROM
- .S RGSTUB=RGFROM_U_RGTO_U_RGICN_U_RGPN_U_RGTP_U_RGAD
- .D EN^RGEQ("SCN_REQ",RGSTUB)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGJCSUB 4088 printed Jan 18, 2025@02:43:16 Page 2
- RGJCSUB ;SF/JC-MPI/PD SUBSCRIPTION GENERATOR ;04/30/97
- +1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,19,27**;30 Apr 99
- EQ(RGEV,RGSTUB,RGERR,RGEP) ;Entry point for Event Queue Processor
- +1 SET FLL=$PIECE(RGSTUB,U)
- SET TLL=$PIECE(RGSTUB,U,2)
- SET ICN=$PIECE(RGSTUB,U,3)
- +2 SET PN=$PIECE(RGSTUB,U,4)
- SET TP=$PIECE(RGSTUB,U,5)
- SET AD=$PIECE(RGSTUB,U,6)
- +3 SET TD=$PIECE(RGSTUB,U,7)
- +4 IF FLL=""!(TLL="")!(ICN="")!(PN="")!(TP="")
- SET RGERR="REQUIRED PARAMETERS MISSING IN STUB"
- +5 ;activation date
- IF AD=""
- SET AD=$$NOW^XLFDT
- SET AD=$$DTFH^RGHLUT(AD,1)
- +6 DO BM(FLL,TLL,ICN,PN,TP,AD,TD)
- +7 QUIT
- BM(FLL,TLL,ICN,PN,TP,AD,TD) ;Build Subscription Request Message
- +1 ;FLL-'FROM' LOGICAL LINK NAME
- +2 ;TLL-'TO' LOGICAL LINK NAME
- +3 ;ICN-PATIENT ID
- +4 ;PN-PATIENT NAME
- +5 ;TP-SUBSCRIPTION TYPE
- +6 ;AD-ACTIVATION DATE HL7 FORMAT
- +7 ;TD-TERMINATION DATE HL7 FORMAT-OPTIONAL
- +8 NEW RGCMOR,RGDFN,RGSSN
- +9 if '+ICN
- QUIT
- +10 SET RGDFN=$$GETDFN^MPIF001(+ICN)
- if +RGDFN<1
- QUIT
- +11 SET RGSSN=$PIECE(^DPT(RGDFN,0),U,9)
- +12 ;Get institution number of CMOR
- +13 SET RGCMOR=$$GETVCCI^MPIF001(RGDFN)
- +14 NEW RGCS,RGRC,RGEC,RGSS,HL
- +15 DO INIT^HLFNC2("RG PT SUBSCRIPTION REQUEST",.HL)
- if +$GET(HL)
- QUIT
- +16 SET HLL("LINKS",1)="RG PT SUBSCRIPTION RECEIVER^"_TLL
- +17 ;Component
- SET RGCS=$EXTRACT(HL("ECH"),1)
- +18 ;Repitition
- SET RGRC=$EXTRACT(HL("ECH"),2)
- +19 ;Escape
- SET RGEC=$EXTRACT(HL("ECH"),3)
- +20 ;Sub-component separator
- SET RGSS=$EXTRACT(HL("ECH"),4)
- MFI ;MFI-master file identifier segment
- +1 NEW X,HLA
- SET X=""
- +2 SET $PIECE(X,HL("FS"))="MFI"
- +3 SET $PIECE(X,HL("FS"),2)="774"_RGCS_"SUBSCRIPTION REGISTRY"_RGCS_"L"
- +4 SET $PIECE(X,HL("FS"),4)="UPD"
- +5 SET $PIECE(X,HL("FS"),7)="NE"
- +6 SET HLA("HLS",1)=X
- MFE ;MFE-master file entry segment
- +1 SET X=""
- +2 SET $PIECE(X,HL("FS"))="MFE"
- +3 SET $PIECE(X,HL("FS"),2)="MUP"
- SET $PIECE(X,HL("FS"),4)=AD
- +4 SET $PIECE(X,HL("FS"),5)=+ICN_RGSS_RGSSN_RGSS_2_RGCS_PN_RGCS_"L"
- +5 SET HLA("HLS",2)=X
- DATA ;Record level data in 'ZSD' SEGMENT
- +1 SET HLA("HLS",3)="ZSD"_HL("FS")_FLL_HL("FS")_TP_HL("FS")_AD_HL("FS")_$GET(TD)_HL("FS")_HL("FS")_RGCMOR
- SEND ;SEND TO HL7 PACKAGE
- +1 NEW HLRST
- +2 DO GENERATE^HLMA("RG PT SUBSCRIPTION REQUEST","LM",1,.HLRST,"",.HL)
- +3 QUIT
- ROUTE ;routing logic-parse A04 and put new message on event queue
- +1 ;to primary facility
- +2 ;If triggered by an A04
- +3 ;I $G(HL("ETN"))'="A04" Q
- +4 ;WITH NEW MESSAGING SUBSCRIPTIONS ARE NO LONGER USED
- +5 QUIT
- +6 KILL RGLL
- DO R1
- +7 KILL RGVCCI,RGVCCIN,RGVCCIS
- +8 QUIT
- R1 ;A04
- +1 NEW RGI,RGFS,RGLOC,RGLOCIEN,RGLOCNM,RGLOCSN,RGPN,RGSN,RGS,RGSCN,RGTP,RGTO
- +2 SET RGS=""
- SET RGFS=HL("FS")
- +3 FOR RGI=1:1
- XECUTE HLNEXT
- if HLQUIT'>0
- QUIT
- if $PIECE(HLNODE,HL("FS"))="PID"
- QUIT
- +4 if HLQUIT'>0
- QUIT
- +5 SET RGICN=+$PIECE(HLNODE,HL("FS"),3)
- +6 if 'RGICN
- QUIT
- +7 SET RGDFN=+$$GETDFN^MPIF001(RGICN)
- +8 if RGDFN'>0
- QUIT
- +9 SET RGVCCI=$$GETVCCI^MPIF001(RGDFN)
- +10 if RGVCCI<1
- QUIT
- +11 ;fix TS need IEN for compare not sta. num.
- +12 SET RGVCCI=$$LKUP^XUAF4(RGVCCI)
- +13 IF RGVCCI=""
- DO START^RGHLLOG(HLMTIEN)
- DO EXC^RGHLLOG(229,"MSG#"_$GET(HLMID)_" Unable to send Subscription. Duplicate station number of "_$$GETVCCI^MPIF001(RGDFN)_" in Institution file.",RGDFN)
- DO STOP^RGHLLOG()
- QUIT
- +14 SET RGPN=$PIECE(^DPT(RGDFN,0),U)
- if RGPN=""
- QUIT
- +15 ;clinical update
- SET RGTP=1
- +16 ;activation date
- SET RGAD=$$NOW^XLFDT
- SET RGAD=$$DTFH^RGHLUT(RGAD,1)
- +17 ;Local Station information
- +18 SET RGLOC=$$SITE^VASITE()
- SET RGLOCIEN=$PIECE(RGLOC,U,1)
- SET RGLOCNM=$PIECE(RGLOC,U,2)
- SET RGLOCSN=$PIECE(RGLOC,U,3)
- +19 ;current site is owner site, update existing subscribers
- IF RGVCCI=RGLOCIEN
- Begin DoDot:1
- +20 ;get SCN
- SET RGSCN=$$GETSCN^RGJCREC(RGDFN)
- +21 ;get local link definition
- DO LINK^HLUTIL3(RGLOCIEN,.RGFROM)
- +22 SET RGLL=$ORDER(RGFROM(0))
- if RGLL=""
- QUIT
- SET RGLL=RGFROM(RGLL)
- +23 DO REC1^RGJCREC
- End DoDot:1
- +24 ;current site is not owner, update only owner
- IF RGVCCI'=RGLOCIEN
- Begin DoDot:1
- +25 ;Local Link
- DO LINK^HLUTIL3(RGLOCIEN,.RGFROM)
- +26 ;sending facility
- SET RGFROM=$ORDER(RGFROM(0))
- if RGFROM=""
- QUIT
- SET RGFROM=RGFROM(RGFROM)
- +27 IF $EXTRACT(RGFROM,1,2)'="VA"
- DO START^RGHLLOG(HLMTIEN)
- DO EXC^RGHLLOG(224,"MSG#"_$GET(HLMID)_" Unable to send Subscription from "_RGFROM_". This is not a MPI/PD Site.",RGDFN)
- DO STOP^RGHLLOG()
- QUIT
- +28 ;get VCCI Link
- DO LINK^HLUTIL3(RGVCCI,.RGTO)
- +29 SET RGTO=$ORDER(RGTO(0))
- if RGTO=""
- QUIT
- +30 ;receiving facility
- SET RGTO=RGTO(RGTO)
- +31 IF $EXTRACT(RGTO,1,2)'="VA"
- DO START^RGHLLOG(HLMTIEN)
- DO EXC^RGHLLOG(224,"MSG#"_$GET(HLMID)_" Unable to send Subscription to "_RGTO_". This is not a MPI/PD Site.",RGDFN)
- DO STOP^RGHLLOG()
- QUIT
- +32 if RGTO=RGFROM
- QUIT
- +33 SET RGSTUB=RGFROM_U_RGTO_U_RGICN_U_RGPN_U_RGTP_U_RGAD
- +34 DO EN^RGEQ("SCN_REQ",RGSTUB)
- End DoDot:1