- RAIPST6 ;HIRMFO/GJC - Post-init number six ;11/23/97 13:25
- VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- ;
- EN1 ; Add the following protocols to file 101 iff they are new
- ; to the Protocol (101) file: RA SEND ORM, RA SEND ORU, RA CANCEL
- ; & RA EVSEND OR. DBIA: 872
- ; Note: The third subscript of RAFDA is the field number in file 101.
- ; Consult a data dictionary for further information.
- SNDORM ; RA SEND ORM protocol
- I '$D(^ORD(101,"B","RA SEND ORM")) D
- . N RA101,RAFDA
- . S RAFDA(101,"+1,",.01)="RA SEND ORM"
- . S RAFDA(101,"+1,",1)="Client for Imaging (ORM)"
- . S RAFDA(101,"+1,",12)=$$PKG^RAIPST5()
- . S RAFDA(101,"+1,",4)="subscriber"
- . S RAFDA(101,"+1,",15)="Q"
- . S RAFDA(101,"+1,",99)=$$TSTMP^RAIPST5()
- . S RAFDA(101,"+1,",770.4)="O01"
- . S RAFDA(101,"+1,",773.1)="NO"
- . S RAFDA(101,"+1,",773.3)="NO"
- . S RAFDA(101,"+1,",20)="Q"
- . S RAFDA(101,"+1,",770.2)="RA-CLIENT-IMG"
- . S RAFDA(101,"+1,",770.6)=$$PROID^RAIPST5()
- . S RAFDA(101,"+1,",771)="Q"
- . S RAFDA(101,"+1,",773.2)="NO"
- . S RAFDA(101,"+1,",773.4)="YES"
- . D MSG^RAIPST5("RA SEND ORM")
- . D UPDATE^DIE("E","RAFDA")
- . I $D(^ORD(101,"B","RA SEND ORM")) D Q
- .. S RA101=$O(^ORD(101,"B","RA SEND ORM",0))
- .. K RAFDA S RAFDA(101,RA101_",",770.95)=2.1 D FILE^DIE("E","RAFDA")
- .. S ^ORD(101,RA101,1,1,0)="This protocol receives the HL7 message."
- .. S ^ORD(101,RA101,1,0)="^^1^1^"_$$DT^XLFDT()_"^^"
- .. Q
- . D ERR^RAIPST5("RA SEND ORM")
- . Q
- SNDORU ; RA SEND ORU protocol
- I '$D(^ORD(101,"B","RA SEND ORU")) D
- . N RA101,RAFDA
- . S RAFDA(101,"+1,",.01)="RA SEND ORU"
- . S RAFDA(101,"+1,",1)="Client for Imaging (ORU)"
- . S RAFDA(101,"+1,",12)=$$PKG^RAIPST5()
- . S RAFDA(101,"+1,",4)="subscriber"
- . S RAFDA(101,"+1,",15)="Q"
- . S RAFDA(101,"+1,",99)=$$TSTMP^RAIPST5()
- . S RAFDA(101,"+1,",770.4)="R01"
- . S RAFDA(101,"+1,",773.1)="NO"
- . S RAFDA(101,"+1,",773.3)="NO"
- . S RAFDA(101,"+1,",20)="Q"
- . S RAFDA(101,"+1,",770.2)="RA-CLIENT-IMG"
- . S RAFDA(101,"+1,",770.6)=$$PROID^RAIPST5()
- . S RAFDA(101,"+1,",771)="Q"
- . S RAFDA(101,"+1,",773.2)="NO"
- . S RAFDA(101,"+1,",773.4)="YES"
- . D MSG^RAIPST5("RA SEND ORU")
- . D UPDATE^DIE("E","RAFDA")
- . I $D(^ORD(101,"B","RA SEND ORU")) D Q
- .. S RA101=$O(^ORD(101,"B","RA SEND ORU",0))
- .. K RAFDA S RAFDA(101,RA101_",",770.95)=2.1 D FILE^DIE("E","RAFDA")
- .. S ^ORD(101,RA101,1,1,0)="This protocol receives the HL7 message."
- .. S ^ORD(101,RA101,1,0)="^^1^1^"_$$DT^XLFDT()_"^^"
- .. Q
- . D ERR^RAIPST5("RA SEND ORU")
- . Q
- CANCEL ; RA CANCEL protocol
- I '$D(^ORD(101,"B","RA CANCEL")) D
- . N RA101,RAFDA
- . S RAFDA(101,"+1,",.01)="RA CANCEL"
- . S RAFDA(101,"+1,",1)="Rad/Nuc Med exam cancellation"
- . S RAFDA(101,"+1,",12)=$$PKG^RAIPST5()
- . S RAFDA(101,"+1,",4)="event driver"
- . S RAFDA(101.01,"+2,+1,",.01)="RA SEND ORM"
- . S RAFDA(101,"+1,",20)="Q"
- . S RAFDA(101,"+1,",770.3)="ORM"
- . S RAFDA(101,"+1,",770.6)=$$PROID^RAIPST5()
- . S RAFDA(101,"+1,",772)="Q"
- . S RAFDA(101,"+1,",99)=$$TSTMP^RAIPST5()
- . S RAFDA(101,"+1,",770.4)="O01"
- . D MSG^RAIPST5("RA CANCEL")
- . D UPDATE^DIE("E","RAFDA")
- . I $D(^ORD(101,"B","RA CANCEL")) D Q
- .. S RA101=$O(^ORD(101,"B","RA CANCEL",0))
- .. K RAFDA S RAFDA(101,RA101_",",770.95)=2.1 D FILE^DIE("E","RAFDA")
- .. S ^ORD(101,RA101,1,1,0)="This protocol is triggered whenever a Radiology/Nuclear Medicine exam is"
- .. S ^ORD(101,RA101,1,2,0)="cancelled. It executes code that creates an HL7 ORM message consisting of"
- .. S ^ORD(101,RA101,1,3,0)="PID, ORC, OBR and OBX segments. The message contains all relevant"
- .. S ^ORD(101,RA101,1,4,0)="information about the exam, including procedure, time of cancellation,"
- .. S ^ORD(101,RA101,1,5,0)="procedure modifiers, patient allergies and clinical history."
- .. S ^ORD(101,RA101,1,0)="^^5^5^"_$$DT^XLFDT()_"^^"
- .. Q
- . D ERR^RAIPST5("RA CANCEL")
- . Q
- EVSEND ; RA EVSEND OR protocol
- I '$D(^ORD(101,"B","RA EVSEND OR")) D
- . N RA101,RAFDA
- . S RAFDA(101,"+1,",.01)="RA EVSEND OR"
- . S RAFDA(101,"+1,",1)="Rad/Nuc Med event sent to OE/RR"
- . S RAFDA(101,"+1,",12)=$$PKG^RAIPST5()
- . S RAFDA(101,"+1,",4)="extended action"
- . S RAFDA(101,"+1,",44)="RA EVSEND"
- . S RAFDA(101,"+1,",15)="K:$L($G(RAVARBLE)) @RAVARBLE,RAVARBLE"
- . S RAFDA(101,"+1,",99)=$$TSTMP^RAIPST5()
- . D MSG^RAIPST5("RA EVSEND OR")
- . D UPDATE^DIE("E","RAFDA")
- . I $D(^ORD(101,"B","RA EVSEND OR")) D Q
- .. S RA101=$O(^ORD(101,"B","RA EVSEND OR",0))
- .. S ^ORD(101,RA101,1,1,0)="Invoked when a request is created or changed by the Radiology/Nuclear"
- .. S ^ORD(101,RA101,1,2,0)="Medicine package (the ""backdoor"") and the data is passed to the Order"
- .. S ^ORD(101,RA101,1,3,0)="Entry package, Version 3.0 or greater."
- .. S ^ORD(101,RA101,1,0)="^^3^3^"_$$DT^XLFDT()_"^^"
- .. Q
- . D ERR^RAIPST5("RA EVSEND OR")
- . Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPST6 4835 printed Jan 18, 2025@03:37:32 Page 2
- RAIPST6 ;HIRMFO/GJC - Post-init number six ;11/23/97 13:25
- VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- +1 ;
- EN1 ; Add the following protocols to file 101 iff they are new
- +1 ; to the Protocol (101) file: RA SEND ORM, RA SEND ORU, RA CANCEL
- +2 ; & RA EVSEND OR. DBIA: 872
- +3 ; Note: The third subscript of RAFDA is the field number in file 101.
- +4 ; Consult a data dictionary for further information.
- SNDORM ; RA SEND ORM protocol
- +1 IF '$DATA(^ORD(101,"B","RA SEND ORM"))
- Begin DoDot:1
- +2 NEW RA101,RAFDA
- +3 SET RAFDA(101,"+1,",.01)="RA SEND ORM"
- +4 SET RAFDA(101,"+1,",1)="Client for Imaging (ORM)"
- +5 SET RAFDA(101,"+1,",12)=$$PKG^RAIPST5()
- +6 SET RAFDA(101,"+1,",4)="subscriber"
- +7 SET RAFDA(101,"+1,",15)="Q"
- +8 SET RAFDA(101,"+1,",99)=$$TSTMP^RAIPST5()
- +9 SET RAFDA(101,"+1,",770.4)="O01"
- +10 SET RAFDA(101,"+1,",773.1)="NO"
- +11 SET RAFDA(101,"+1,",773.3)="NO"
- +12 SET RAFDA(101,"+1,",20)="Q"
- +13 SET RAFDA(101,"+1,",770.2)="RA-CLIENT-IMG"
- +14 SET RAFDA(101,"+1,",770.6)=$$PROID^RAIPST5()
- +15 SET RAFDA(101,"+1,",771)="Q"
- +16 SET RAFDA(101,"+1,",773.2)="NO"
- +17 SET RAFDA(101,"+1,",773.4)="YES"
- +18 DO MSG^RAIPST5("RA SEND ORM")
- +19 DO UPDATE^DIE("E","RAFDA")
- +20 IF $DATA(^ORD(101,"B","RA SEND ORM"))
- Begin DoDot:2
- +21 SET RA101=$ORDER(^ORD(101,"B","RA SEND ORM",0))
- +22 KILL RAFDA
- SET RAFDA(101,RA101_",",770.95)=2.1
- DO FILE^DIE("E","RAFDA")
- +23 SET ^ORD(101,RA101,1,1,0)="This protocol receives the HL7 message."
- +24 SET ^ORD(101,RA101,1,0)="^^1^1^"_$$DT^XLFDT()_"^^"
- +25 QUIT
- End DoDot:2
- QUIT
- +26 DO ERR^RAIPST5("RA SEND ORM")
- +27 QUIT
- End DoDot:1
- SNDORU ; RA SEND ORU protocol
- +1 IF '$DATA(^ORD(101,"B","RA SEND ORU"))
- Begin DoDot:1
- +2 NEW RA101,RAFDA
- +3 SET RAFDA(101,"+1,",.01)="RA SEND ORU"
- +4 SET RAFDA(101,"+1,",1)="Client for Imaging (ORU)"
- +5 SET RAFDA(101,"+1,",12)=$$PKG^RAIPST5()
- +6 SET RAFDA(101,"+1,",4)="subscriber"
- +7 SET RAFDA(101,"+1,",15)="Q"
- +8 SET RAFDA(101,"+1,",99)=$$TSTMP^RAIPST5()
- +9 SET RAFDA(101,"+1,",770.4)="R01"
- +10 SET RAFDA(101,"+1,",773.1)="NO"
- +11 SET RAFDA(101,"+1,",773.3)="NO"
- +12 SET RAFDA(101,"+1,",20)="Q"
- +13 SET RAFDA(101,"+1,",770.2)="RA-CLIENT-IMG"
- +14 SET RAFDA(101,"+1,",770.6)=$$PROID^RAIPST5()
- +15 SET RAFDA(101,"+1,",771)="Q"
- +16 SET RAFDA(101,"+1,",773.2)="NO"
- +17 SET RAFDA(101,"+1,",773.4)="YES"
- +18 DO MSG^RAIPST5("RA SEND ORU")
- +19 DO UPDATE^DIE("E","RAFDA")
- +20 IF $DATA(^ORD(101,"B","RA SEND ORU"))
- Begin DoDot:2
- +21 SET RA101=$ORDER(^ORD(101,"B","RA SEND ORU",0))
- +22 KILL RAFDA
- SET RAFDA(101,RA101_",",770.95)=2.1
- DO FILE^DIE("E","RAFDA")
- +23 SET ^ORD(101,RA101,1,1,0)="This protocol receives the HL7 message."
- +24 SET ^ORD(101,RA101,1,0)="^^1^1^"_$$DT^XLFDT()_"^^"
- +25 QUIT
- End DoDot:2
- QUIT
- +26 DO ERR^RAIPST5("RA SEND ORU")
- +27 QUIT
- End DoDot:1
- CANCEL ; RA CANCEL protocol
- +1 IF '$DATA(^ORD(101,"B","RA CANCEL"))
- Begin DoDot:1
- +2 NEW RA101,RAFDA
- +3 SET RAFDA(101,"+1,",.01)="RA CANCEL"
- +4 SET RAFDA(101,"+1,",1)="Rad/Nuc Med exam cancellation"
- +5 SET RAFDA(101,"+1,",12)=$$PKG^RAIPST5()
- +6 SET RAFDA(101,"+1,",4)="event driver"
- +7 SET RAFDA(101.01,"+2,+1,",.01)="RA SEND ORM"
- +8 SET RAFDA(101,"+1,",20)="Q"
- +9 SET RAFDA(101,"+1,",770.3)="ORM"
- +10 SET RAFDA(101,"+1,",770.6)=$$PROID^RAIPST5()
- +11 SET RAFDA(101,"+1,",772)="Q"
- +12 SET RAFDA(101,"+1,",99)=$$TSTMP^RAIPST5()
- +13 SET RAFDA(101,"+1,",770.4)="O01"
- +14 DO MSG^RAIPST5("RA CANCEL")
- +15 DO UPDATE^DIE("E","RAFDA")
- +16 IF $DATA(^ORD(101,"B","RA CANCEL"))
- Begin DoDot:2
- +17 SET RA101=$ORDER(^ORD(101,"B","RA CANCEL",0))
- +18 KILL RAFDA
- SET RAFDA(101,RA101_",",770.95)=2.1
- DO FILE^DIE("E","RAFDA")
- +19 SET ^ORD(101,RA101,1,1,0)="This protocol is triggered whenever a Radiology/Nuclear Medicine exam is"
- +20 SET ^ORD(101,RA101,1,2,0)="cancelled. It executes code that creates an HL7 ORM message consisting of"
- +21 SET ^ORD(101,RA101,1,3,0)="PID, ORC, OBR and OBX segments. The message contains all relevant"
- +22 SET ^ORD(101,RA101,1,4,0)="information about the exam, including procedure, time of cancellation,"
- +23 SET ^ORD(101,RA101,1,5,0)="procedure modifiers, patient allergies and clinical history."
- +24 SET ^ORD(101,RA101,1,0)="^^5^5^"_$$DT^XLFDT()_"^^"
- +25 QUIT
- End DoDot:2
- QUIT
- +26 DO ERR^RAIPST5("RA CANCEL")
- +27 QUIT
- End DoDot:1
- EVSEND ; RA EVSEND OR protocol
- +1 IF '$DATA(^ORD(101,"B","RA EVSEND OR"))
- Begin DoDot:1
- +2 NEW RA101,RAFDA
- +3 SET RAFDA(101,"+1,",.01)="RA EVSEND OR"
- +4 SET RAFDA(101,"+1,",1)="Rad/Nuc Med event sent to OE/RR"
- +5 SET RAFDA(101,"+1,",12)=$$PKG^RAIPST5()
- +6 SET RAFDA(101,"+1,",4)="extended action"
- +7 SET RAFDA(101,"+1,",44)="RA EVSEND"
- +8 SET RAFDA(101,"+1,",15)="K:$L($G(RAVARBLE)) @RAVARBLE,RAVARBLE"
- +9 SET RAFDA(101,"+1,",99)=$$TSTMP^RAIPST5()
- +10 DO MSG^RAIPST5("RA EVSEND OR")
- +11 DO UPDATE^DIE("E","RAFDA")
- +12 IF $DATA(^ORD(101,"B","RA EVSEND OR"))
- Begin DoDot:2
- +13 SET RA101=$ORDER(^ORD(101,"B","RA EVSEND OR",0))
- +14 SET ^ORD(101,RA101,1,1,0)="Invoked when a request is created or changed by the Radiology/Nuclear"
- +15 SET ^ORD(101,RA101,1,2,0)="Medicine package (the ""backdoor"") and the data is passed to the Order"
- +16 SET ^ORD(101,RA101,1,3,0)="Entry package, Version 3.0 or greater."
- +17 SET ^ORD(101,RA101,1,0)="^^3^3^"_$$DT^XLFDT()_"^^"
- +18 QUIT
- End DoDot:2
- QUIT
- +19 DO ERR^RAIPST5("RA EVSEND OR")
- +20 QUIT
- End DoDot:1
- +21 QUIT