RA12PST1 ;HIRMFO/CRT - Post-init number one (patch seventeen) ;5/19/99
VERSION ;;5.0;Radiology/Nuclear Medicine;**17**;Mar 16, 1998
;
Q:'$$PATCH^XPDUTL("HL*1.6*57") ; Only run if HL*1.6*57 installed.
;
EN1 ; Add entries to the HL Logical Link (870) file.
;
; *** Add entries to HL Logical Link (870) file ***
;
MSRA I $D(^HLCS(870,"B","MED-RA")) D
.N RAFDA
.S RAIENS=$O(^HLCS(870,"B","MED-RA",0))
.Q:+RAIENS'>0
.S RAFDA(870,RAIENS_",",400.04)="@"
.D MSG^RA12PST2("MED-RA",870)
.D UPDATE^DIE("E","RAFDA")
.Q
;
RAPS D MSG^RA12PST2("RA-PSCRIBE",870)
I '$D(^HLCS(870,"B","RA-PSCRIBE")) S RAIENS="+1,"
I $D(^HLCS(870,"B","RA-PSCRIBE")) D
.S RAIENS=$O(^HLCS(870,"B","RA-PSCRIBE",0))
.S RAIENS=RAIENS_","
G:+RAIENS'>0 PSRA
N RAFDA
S RAFDA(870,RAIENS,.01)="RA-PSCRIBE"
S RAFDA(870,RAIENS,2)=$$TCP^RA12PST2()
S RAFDA(870,RAIENS,3)="PC"
S RAFDA(870,RAIENS,200.05)=$$ACKTO^RA12PST2()
S RAFDA(870,RAIENS,400.03)=$$CLIENT^RA12PST2()
S RAFDA(870,RAIENS,400.04)=$$Y^RA12PST2()
D UPDATE^DIE("E","RAFDA")
D:'$D(^HLCS(870,"B","RA-PSCRIBE")) MSG^RA12PST2("RA-PSCRIBE",870,1)
;
PSRA D MSG^RA12PST2("PSCRIBE-RA",870)
I '$D(^HLCS(870,"B","PSCRIBE-RA")) S RAIENS="+1,"
I $D(^HLCS(870,"B","PSCRIBE-RA")) D
. S RAIENS=$O(^HLCS(870,"B","PSCRIBE-RA",0))
. S RAIENS=RAIENS_","
G:+RAIENS'>0 TARA
N RAFDA
S RAFDA(870,RAIENS,.01)="PSCRIBE-RA"
S RAFDA(870,RAIENS,2)=$$TCP^RA12PST2()
S RAFDA(870,RAIENS,3)="SS"
S RAFDA(870,RAIENS,400.03)=$$SLISTN^RA12PST2()
S RAFDA(870,RAIENS,400.04)="@"
D UPDATE^DIE("E","RAFDA")
D:'$D(^HLCS(870,"B","PSCRIBE-RA")) MSG^RA12PST2("PSCRIBE-RA",870,1)
;
TARA D MSG^RA12PST2("TALK-RA",870)
I '$D(^HLCS(870,"B","TALK-RA")) S RAIENS="+1,"
I $D(^HLCS(870,"B","TALK-RA")) D
. S RAIENS=$O(^HLCS(870,"B","TALK-RA",0))
. S RAIENS=RAIENS_","
G:+RAIENS'>0 RATA
N RAFDA
S RAFDA(870,RAIENS,.01)="TALK-RA"
S RAFDA(870,RAIENS,2)=$$TCP^RA12PST2()
S RAFDA(870,RAIENS,3)="SS"
S RAFDA(870,RAIENS,400.03)=$$SLISTN^RA12PST2()
S RAFDA(870,RAIENS,400.04)="@"
D UPDATE^DIE("E","RAFDA")
D:'$D(^HLCS(870,"B","TALK-RA")) MSG^RA12PST2("TALK-RA",870,1)
;
RATA D MSG^RA12PST2("RA-TALK",870)
I '$D(^HLCS(870,"B","RA-TALK")) S RAIENS="+1,"
I $D(^HLCS(870,"B","RA-TALK")) D
. S RAIENS=$O(^HLCS(870,"B","RA-TALK",0))
. S RAIENS=RAIENS_","
G:+RAIENS'>0 END
N RAFDA
S RAFDA(870,RAIENS,.01)="RA-TALK"
S RAFDA(870,RAIENS,2)=$$TCP^RA12PST2()
S RAFDA(870,RAIENS,3)="PC"
S RAFDA(870,RAIENS,200.05)=$$ACKTO^RA12PST2()
S RAFDA(870,RAIENS,400.03)=$$CLIENT^RA12PST2()
S RAFDA(870,RAIENS,400.04)=$$Y^RA12PST2()
D UPDATE^DIE("E","RAFDA")
D:'$D(^HLCS(870,"B","RA-TALK")) MSG^RA12PST2("RA-TALK",870,1)
;
END ; *** End adding entries to HL Logical Link (870) file ***
D BMES^XPDUTL(" ") ; greater readability
;
D EN1^RA12PST3
Q
RA12PST1 ;HIRMFO/CRT - Post-init number one (patch seventeen) ;5/19/99
VERSION ;;5.0;Radiology/Nuclear Medicine;**17**;Mar 16, 1998
+1 ;
+2 ; Only run if HL*1.6*57 installed.
IF '$$PATCH^XPDUTL("HL*1.6*57")
QUIT
+3 ;
EN1 ; Add entries to the HL Logical Link (870) file.
+1 ;
+2 ; *** Add entries to HL Logical Link (870) file ***
+3 ;
MSRA IF $DATA(^HLCS(870,"B","MED-RA"))
Begin DoDot:1
+1 NEW RAFDA
+2 SET RAIENS=$ORDER(^HLCS(870,"B","MED-RA",0))
+3 IF +RAIENS'>0
QUIT
+4 SET RAFDA(870,RAIENS_",",400.04)="@"
+5 DO MSG^RA12PST2("MED-RA",870)
+6 DO UPDATE^DIE("E","RAFDA")
+7 QUIT
End DoDot:1
+8 ;
RAPS DO MSG^RA12PST2("RA-PSCRIBE",870)
+1 IF '$DATA(^HLCS(870,"B","RA-PSCRIBE"))
SET RAIENS="+1,"
+2 IF $DATA(^HLCS(870,"B","RA-PSCRIBE"))
Begin DoDot:1
+3 SET RAIENS=$ORDER(^HLCS(870,"B","RA-PSCRIBE",0))
+4 SET RAIENS=RAIENS_","
End DoDot:1
+5 IF +RAIENS'>0
GOTO PSRA
+6 NEW RAFDA
+7 SET RAFDA(870,RAIENS,.01)="RA-PSCRIBE"
+8 SET RAFDA(870,RAIENS,2)=$$TCP^RA12PST2()
+9 SET RAFDA(870,RAIENS,3)="PC"
+10 SET RAFDA(870,RAIENS,200.05)=$$ACKTO^RA12PST2()
+11 SET RAFDA(870,RAIENS,400.03)=$$CLIENT^RA12PST2()
+12 SET RAFDA(870,RAIENS,400.04)=$$Y^RA12PST2()
+13 DO UPDATE^DIE("E","RAFDA")
+14 IF '$DATA(^HLCS(870,"B","RA-PSCRIBE"))
DO MSG^RA12PST2("RA-PSCRIBE",870,1)
+15 ;
PSRA DO MSG^RA12PST2("PSCRIBE-RA",870)
+1 IF '$DATA(^HLCS(870,"B","PSCRIBE-RA"))
SET RAIENS="+1,"
+2 IF $DATA(^HLCS(870,"B","PSCRIBE-RA"))
Begin DoDot:1
+3 SET RAIENS=$ORDER(^HLCS(870,"B","PSCRIBE-RA",0))
+4 SET RAIENS=RAIENS_","
End DoDot:1
+5 IF +RAIENS'>0
GOTO TARA
+6 NEW RAFDA
+7 SET RAFDA(870,RAIENS,.01)="PSCRIBE-RA"
+8 SET RAFDA(870,RAIENS,2)=$$TCP^RA12PST2()
+9 SET RAFDA(870,RAIENS,3)="SS"
+10 SET RAFDA(870,RAIENS,400.03)=$$SLISTN^RA12PST2()
+11 SET RAFDA(870,RAIENS,400.04)="@"
+12 DO UPDATE^DIE("E","RAFDA")
+13 IF '$DATA(^HLCS(870,"B","PSCRIBE-RA"))
DO MSG^RA12PST2("PSCRIBE-RA",870,1)
+14 ;
TARA DO MSG^RA12PST2("TALK-RA",870)
+1 IF '$DATA(^HLCS(870,"B","TALK-RA"))
SET RAIENS="+1,"
+2 IF $DATA(^HLCS(870,"B","TALK-RA"))
Begin DoDot:1
+3 SET RAIENS=$ORDER(^HLCS(870,"B","TALK-RA",0))
+4 SET RAIENS=RAIENS_","
End DoDot:1
+5 IF +RAIENS'>0
GOTO RATA
+6 NEW RAFDA
+7 SET RAFDA(870,RAIENS,.01)="TALK-RA"
+8 SET RAFDA(870,RAIENS,2)=$$TCP^RA12PST2()
+9 SET RAFDA(870,RAIENS,3)="SS"
+10 SET RAFDA(870,RAIENS,400.03)=$$SLISTN^RA12PST2()
+11 SET RAFDA(870,RAIENS,400.04)="@"
+12 DO UPDATE^DIE("E","RAFDA")
+13 IF '$DATA(^HLCS(870,"B","TALK-RA"))
DO MSG^RA12PST2("TALK-RA",870,1)
+14 ;
RATA DO MSG^RA12PST2("RA-TALK",870)
+1 IF '$DATA(^HLCS(870,"B","RA-TALK"))
SET RAIENS="+1,"
+2 IF $DATA(^HLCS(870,"B","RA-TALK"))
Begin DoDot:1
+3 SET RAIENS=$ORDER(^HLCS(870,"B","RA-TALK",0))
+4 SET RAIENS=RAIENS_","
End DoDot:1
+5 IF +RAIENS'>0
GOTO END
+6 NEW RAFDA
+7 SET RAFDA(870,RAIENS,.01)="RA-TALK"
+8 SET RAFDA(870,RAIENS,2)=$$TCP^RA12PST2()
+9 SET RAFDA(870,RAIENS,3)="PC"
+10 SET RAFDA(870,RAIENS,200.05)=$$ACKTO^RA12PST2()
+11 SET RAFDA(870,RAIENS,400.03)=$$CLIENT^RA12PST2()
+12 SET RAFDA(870,RAIENS,400.04)=$$Y^RA12PST2()
+13 DO UPDATE^DIE("E","RAFDA")
+14 IF '$DATA(^HLCS(870,"B","RA-TALK"))
DO MSG^RA12PST2("RA-TALK",870,1)
+15 ;
END ; *** End adding entries to HL Logical Link (870) file ***
+1 ; greater readability
DO BMES^XPDUTL(" ")
+2 ;
+3 DO EN1^RA12PST3
+4 QUIT
