ENX4IPR ;WIRMFO/DH-PRE-INIT ;7.8.98
;;7.0;ENGINEERING;**51**;Aug 17, 1993
; acquire some site specific bar code usage information
; and keep an eye on accession numbers
N J,K,M
Q:$$PATCH^XPDUTL("EN*7.0*51") ;No need to do this more than once
K ^TMP($J) S M=1
I $D(^ENG(6914,0)) S ^TMP($J,1,M)=^ENG(6914,0),M=M+1
I $D(^PRCT(446.4,0)) D
. S J=0 F S J=$O(^PRCT(446.4,J)) Q:'J I $D(^PRCT(446.4,J,2,0)) S ^TMP($J,1,M)=J_U_^PRCT(446.4,J,2,0),M=M+1
. S J="" F S J=$O(^PRCT(446.4,"B",J)) Q:J="" S K=$O(^(J,0)) I K S ^TMP($J,1,M)="B"_U_J_U_K,M=M+1
I $O(^PRCT(446.4,0,""))]"" S ^TMP($J,1,M)="Top node of ^PRCT(446.4 corrupted."
I $D(^TMP($J)) D
. S XMY("HEIBY,D@DOMAIN.EXT")="",XMDUZ=.5
. S XMSUB="Patch EN*7*51 Status Report",XMTEXT="^TMP($J,1,"
. D ^XMD
. K XMY,XMDUZ,XMSUB,XMTEXT
K ^TMP($J)
Q
;ENX4IPR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENX4IPR 841 printed Oct 16, 2024@17:57:24 Page 2
ENX4IPR ;WIRMFO/DH-PRE-INIT ;7.8.98
+1 ;;7.0;ENGINEERING;**51**;Aug 17, 1993
+2 ; acquire some site specific bar code usage information
+3 ; and keep an eye on accession numbers
+4 NEW J,K,M
+5 ;No need to do this more than once
if $$PATCH^XPDUTL("EN*7.0*51")
QUIT
+6 KILL ^TMP($JOB)
SET M=1
+7 IF $DATA(^ENG(6914,0))
SET ^TMP($JOB,1,M)=^ENG(6914,0)
SET M=M+1
+8 IF $DATA(^PRCT(446.4,0))
Begin DoDot:1
+9 SET J=0
FOR
SET J=$ORDER(^PRCT(446.4,J))
if 'J
QUIT
IF $DATA(^PRCT(446.4,J,2,0))
SET ^TMP($JOB,1,M)=J_U_^PRCT(446.4,J,2,0)
SET M=M+1
+10 SET J=""
FOR
SET J=$ORDER(^PRCT(446.4,"B",J))
if J=""
QUIT
SET K=$ORDER(^(J,0))
IF K
SET ^TMP($JOB,1,M)="B"_U_J_U_K
SET M=M+1
End DoDot:1
+11 IF $ORDER(^PRCT(446.4,0,""))]""
SET ^TMP($JOB,1,M)="Top node of ^PRCT(446.4 corrupted."
+12 IF $DATA(^TMP($JOB))
Begin DoDot:1
+13 SET XMY("HEIBY,D@DOMAIN.EXT")=""
SET XMDUZ=.5
+14 SET XMSUB="Patch EN*7*51 Status Report"
SET XMTEXT="^TMP($J,1,"
+15 DO ^XMD
+16 KILL XMY,XMDUZ,XMSUB,XMTEXT
End DoDot:1
+17 KILL ^TMP($JOB)
+18 QUIT
+19 ;ENX4IPR
