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

RAAIPST1.m

Go to the documentation of this file. 
  1. RAAIPST1 ;HIRMFO/GJC - Post-init number one (patch four) ;1/7/98  08:27
  1. VERSION ;;5.0;Radiology/Nuclear Medicine;**4**;Mar 16, 1998
  1.  ;
  1. EN1 ; Add entries to the HL LL Protocol Param (869.2) file, HL Logical
  1.  ; Link (870) file, HL7 Application Param (771) and the Protocol (101)
  1.  ; file.
  1.  ; ***    Add entries to HL LL Protocol Param (869.2) file     ***
  1.  I '$D(^HLCS(869.2,"B","RA-MED LLP")) D
  1.  . N RAFDA S RAFDA(869.2,"+1,",.01)="RA-MED LLP"
  1.  . S RAFDA(869.2,"+1,",.02)=$$TCP()
  1.  . S RAFDA(869.2,"+1,",400.03)=$$CLIENT()
  1.  . S RAFDA(869.2,"+1,",400.04)=$$Y()
  1.  . D MSG^RAAIPST2("RA-MED LLP",869.2),UPDATE^DIE("E","RAFDA")
  1.  . D:'$D(^HLCS(869.2,"B","RA-MED LLP")) MSG^RAAIPST2("RA-MED LLP",869.2,1)
  1.  . Q
  1.  I '$D(^HLCS(869.2,"B","MED-RA LLP")) D
  1.  . N RAFDA S RAFDA(869.2,"+1,",.01)="MED-RA LLP"
  1.  . S RAFDA(869.2,"+1,",.02)=$$TCP()
  1.  . S RAFDA(869.2,"+1,",400.03)=$$SLISTN()
  1.  . S RAFDA(869.2,"+1,",400.04)=$$Y()
  1.  . D MSG^RAAIPST2("MED-RA LLP",869.2),UPDATE^DIE("E","RAFDA")
  1.  . D:'$D(^HLCS(869.2,"B","MED-RA LLP")) MSG^RAAIPST2("MED-RA LLP",869.2,1)
  1.  . Q
  1.  ; *** End adding entries to HL LL Protocol Param (869.2) file ***
  1.  D BMES^XPDUTL(" ") ; greater readability
  1.  ; ***    Add entries to HL Logical Link (870) file     ***
  1.  I '$D(^HLCS(870,"B","RA-MED")) D
  1.  . N RAFDA S RAFDA(870,"+1,",.01)="RA-MED"
  1.  . S RAFDA(870,"+1,",2)="TCP"  ;IHS/ITSC/CLS 04/25/2003
  1.  . D MSG^RAAIPST2("RA-MED",870),UPDATE^DIE("E","RAFDA")
  1.  . D:'$D(^HLCS(870,"B","RA-MED")) MSG^RAAIPST2("RA-MED",870,1)
  1.  . Q
  1.  I '$D(^HLCS(870,"B","MED-RA")) D
  1.  . N RAFDA S RAFDA(870,"+1,",.01)="MED-RA"
  1.  . S RAFDA(870,"+1,",2)="TCP"  ;IHS/ITSC/CLS 04/25/2003
  1.  . D MSG^RAAIPST2("MED-RA",870),UPDATE^DIE("E","RAFDA")
  1.  . D:'$D(^HLCS(870,"B","MED-RA")) MSG^RAAIPST2("MED-RA",870,1)
  1.  . Q
  1.  ; *** End adding entries to HL Logical Link (870) file ***
  1.  D BMES^XPDUTL(" ") ; greater readability
  1.  ; ***    Add entries to HL7 Application Param (771) file     ***
  1.  I '$D(^HL(771,"B","RA-SERVER-IMG")) D
  1.  . N RAFDA S RAFDA(771,"+1,",.01)="RA-SERVER-IMG"
  1.  . S RAFDA(771,"+1,",2)=$$ACTIVE()
  1.  . S RAFDA(771,"+1,",7)=$$US()
  1.  . D MSG^RAAIPST2("RA-SERVER-IMG",771),UPDATE^DIE("E","RAFDA")
  1.  . D:'$D(^HL(771,"B","RA-SERVER-IMG")) MSG^RAAIPST2("RA-SERVER-IMG",771,1)
  1.  . Q
  1.  I '$D(^HL(771,"B","RA-CLIENT-TCP")) D
  1.  . N RAFDA S RAFDA(771,"+1,",.01)="RA-CLIENT-TCP"
  1.  . S RAFDA(771,"+1,",2)=$$ACTIVE()
  1.  . S RAFDA(771,"+1,",7)=$$US()
  1.  . D MSG^RAAIPST2("RA-CLIENT-TCP",771),UPDATE^DIE("E","RAFDA")
  1.  . D:'$D(^HL(771,"B","RA-CLIENT-TCP")) MSG^RAAIPST2("RA-CLIENT-TCP",771,1)
  1.  . Q
  1.  ; *** End adding entries to HL7 Application Param (771) file ***
  1.  D BMES^XPDUTL(" ") ; greater readability
  1.  ; ***   Adding entries to the Protocol (101) file   ***
  1.  I '$D(^ORD(101,"B","RA TCP ORM")) D
  1.  . N RA101,RAFDA
  1.  . S RAFDA(101,"+1,",.01)="RA TCP ORM"
  1.  . S RAFDA(101,"+1,",1)="TCP Client"
  1.  . S RAFDA(101,"+1,",4)="subscriber"
  1.  . S RAFDA(101,"+1,",12)="RADIOLOGY/NUCLEAR MEDICINE"
  1.  . S RAFDA(101,"+1,",15)="Q"
  1.  . S RAFDA(101,"+1,",20)="Q"
  1.  . S RAFDA(101,"+1,",99)=$$FMTH^XLFDT($$NOW^XLFDT())
  1.  . S RAFDA(101,"+1,",770.2)="RA-CLIENT-TCP"
  1.  . S RAFDA(101,"+1,",770.3)="ACK"
  1.  . S RAFDA(101,"+1,",770.4)="O01"
  1.  . S RAFDA(101,"+1,",770.6)=""  ;IHS/ITSC/CLS 04/25/2003
  1.  . S RAFDA(101,"+1,",770.7)="RA-MED"
  1.  . S RAFDA(101,"+1,",770.11)="ORM"
  1.  . S RAFDA(101,"+1,",771)="Q"
  1.  . S RAFDA(101,"+1,",773.1)=$$N(),RAFDA(101,"+1,",773.2)=$$N()
  1.  . S RAFDA(101,"+1,",773.3)=$$N(),RAFDA(101,"+1,",773.4)=$$Y()
  1.  . D MSG^RAAIPST2("RA TCP ORM",101),UPDATE^DIE("E","RAFDA")
  1.  . I $D(^ORD(101,"B","RA TCP ORM")) D  Q
  1.  .. S RA101=$O(^ORD(101,"B","RA TCP ORM",0)) K RAFDA
  1.  .. S RAFDA(101,RA101_",",770.95)=2.1 D FILE^DIE("E","RAFDA")
  1.  .. S ^ORD(101,RA101,1,1,0)="This protocol is used in conjunction with the RA REG, RA EXAMINED, and RA"
  1.  .. S ^ORD(101,RA101,1,2,0)="CANCEL event protocols.  It is used by the VISTA HL7 package to send"
  1.  .. S ^ORD(101,RA101,1,3,0)="ORM messages to TCP/IP recipients.  This protocol should be entered in the"
  1.  .. S ^ORD(101,RA101,1,4,0)="ITEM multiple field of those event point protocols if this type of"
  1.  .. S ^ORD(101,RA101,1,5,0)="messaging scenerio is used at a facility.  This is part of the file set-up"
  1.  .. S ^ORD(101,RA101,1,6,0)="to enable HL7 message flow when exams are registered, cancelled, and when"
  1.  .. S ^ORD(101,RA101,1,7,0)="they reach the status flagged as 'examined' by the site."
  1.  .. S ^ORD(101,RA101,1,0)="^^7^7^"_$$DT^XLFDT()_"^^"
  1.  .. Q
  1.  . D MSG^RAAIPST2("RA TCP ORM",101,1)
  1.  . Q
  1.  I '$D(^ORD(101,"B","RA TCP ORU")) D
  1.  . N RA101,RAFDA
  1.  . S RAFDA(101,"+1,",.01)="RA TCP ORU"
  1.  . S RAFDA(101,"+1,",1)="TCP Client"
  1.  . S RAFDA(101,"+1,",4)="subscriber"
  1.  . S RAFDA(101,"+1,",12)="RADIOLOGY/NUCLEAR MEDICINE"
  1.  . S RAFDA(101,"+1,",15)="Q"
  1.  . S RAFDA(101,"+1,",20)="Q"
  1.  . S RAFDA(101,"+1,",99)=$$FMTH^XLFDT($$NOW^XLFDT())
  1.  . S RAFDA(101,"+1,",770.2)="RA-CLIENT-TCP"
  1.  . S RAFDA(101,"+1,",770.3)="ACK"
  1.  . S RAFDA(101,"+1,",770.4)="R01"
  1.  . S RAFDA(101,"+1,",770.6)=""  ;IHS/ITSC/CLS 04/25/2003
  1.  . S RAFDA(101,"+1,",770.7)="RA-MED"
  1.  . S RAFDA(101,"+1,",770.11)="ORU"
  1.  . S RAFDA(101,"+1,",771)="Q"
  1.  . S RAFDA(101,"+1,",773.1)=$$N(),RAFDA(101,"+1,",773.2)=$$N()
  1.  . S RAFDA(101,"+1,",773.3)=$$N(),RAFDA(101,"+1,",773.4)=$$Y()
  1.  . D MSG^RAAIPST2("RA TCP ORU",101),UPDATE^DIE("E","RAFDA")
  1.  . I $D(^ORD(101,"B","RA TCP ORU")) D  Q
  1.  .. S RA101=$O(^ORD(101,"B","RA TCP ORU",0)) K RAFDA
  1.  .. S RAFDA(101,RA101_",",770.95)=2.1 D FILE^DIE("E","RAFDA")
  1.  .. S ^ORD(101,RA101,1,1,0)="This protocol is used in conjunction with the RA RPT event point protocol."
  1.  .. S ^ORD(101,RA101,1,2,0)="The HL7 package uses this protocol to send rad/nuc med report (ORU)"
  1.  .. S ^ORD(101,RA101,1,3,0)="messages to TCP/IP recipients.  This protocol should be entered in the"
  1.  .. S ^ORD(101,RA101,1,4,0)="ITEM multiple field of the RA RPT protocol if this messaging scenerio is"
  1.  .. S ^ORD(101,RA101,1,5,0)="used in a facility.  This is part of the file set-up to enable message"
  1.  .. S ^ORD(101,RA101,1,6,0)="flow when a rad/nuc med report is verified."
  1.  .. S ^ORD(101,RA101,1,0)="^^6^6^"_$$DT^XLFDT()_"^^"
  1.  .. Q
  1.  . D MSG^RAAIPST2("RA TCP ORU",101,1)
  1.  . Q
  1.  D EN1^RAAIPST2 ; continue to add protocols and items under existing
  1.  ; protocols.
  1.  ; *** End adding entries to the Protocol (101) file ***
  1.  Q
  1. ACTIVE() ; return 'ACTIVE', for ACTIVE/INACTIVE (2) field in file
  1.  ; 771
  1.  Q "ACTIVE"
  1. CLIENT() ; return 'CLIENT (SENDER)', for CLIENT/SERVER (400.03) field
  1.  ; in file 869.2
  1.  Q "CLIENT (SENDER)"
  1. MSG(ENTRY,FILE,ERR) ; display a status message pertaining to the addition
  1.  ; of entries to files: 869.2, 870, 771 & 101.  Display a status message
  1.  ; when items are added to the Protocol (101) file.
  1.  ; Variable list:
  1.  ; ENTRY-> value of the .01 field for a particular file (60 chars max)
  1.  ; FILE -> file # where the data will be added
  1.  ; ERR  -> err message? 1 if yes, else null
  1.  N RACNT,RATXT,STRING,WORDS S RACNT=1,RATXT(RACNT)=" "
  1.  S:$G(ERR) STRING="* ERROR * "
  1.  S STRING=$G(STRING)_"Adding '"_$E(ENTRY,1,40)_"' to the "
  1.  S STRING=$G(STRING)_$E($P($G(^DIC(FILE,0)),"^"),1,40)_" file."
  1.  S:$G(ERR)&($D(DIERR)) STRING=$G(STRING)_" "_$E($G(^TMP("DIERR",$J,1,"TEXT",1)),1,115) ; display the 1st error text encountered! (there may be more errors. Because of possible string length error display only the first error.)
  1.  S:$G(ERR) STRING=$G(STRING)_" IRM should investigate."
  1.  F  D  Q:STRING=""
  1.  . S WORDS=$L($E(STRING,1,71)," ")
  1.  . S RACNT=RACNT+1,RATXT(RACNT)=$P(STRING," ",1,WORDS)
  1.  . S STRING=$P(STRING," ",WORDS+1,999)
  1.  . Q
  1.  D MES^XPDUTL(.RATXT)
  1.  Q
  1. N() ; return 'NO', for various fields in file 101
  1.  Q "NO"
  1. SLISTN() ; return 'SINGLE LISTENER', for CLIENT/SERVER (400.03) field
  1.  ; in file 869.2
  1.  Q "SINGLE LISTENER"
  1. TCP() ; return 'TCP' for LLP TYPE (.02) field in file 869.2
  1.  Q "TCP"
  1. US() ; return 'US', for COUNTRY CODE (7) field in file 771
  1.  Q "US"
  1. Y() ; return 'YES', for PERMANENT (400.04) field in file 869.2
  1.  Q "YES"