ENX4IPR.m

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 ---ENX4IPR   841     printed  Apr 09, 2024@20:59:19                                                                                                                                                                                                      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