Routine: RA148PST

RA148PST ;ABV/MKN - Post Install;10/5/2018 11:28 AM

 ;;5.0;Radiology/Nuclear Medicine;**148**;Mar 16, 1998;Build 59

EN ;

 ;First change the name of the seven -AUTO consult services (files #123.5 and #101.43),

 ;if they exist, to move the hyphen

 ;  Example:  "COMMUNITY CARE IMAGING-CT-AUTO"  to  "COMMUNITY CARE-IMAGING CT-AUTO"

 N DA,DIE,DR,ORN,RAFROM,RAI,RATO,X

 F RAI=1:1 S X=$T(LIST+RAI) Q:X=" ;//"  S RAFROM=$P(X,";",2),RATO=$P(X,";",3) D

 .S DA=$O(^GMR(123.5,"B",RAFROM,"")) D:DA

 ..S DIE="^GMR(123.5,",DR=".01///"_RATO D ^DIE

 .S DA=$O(^ORD(101.43,"B",$E(RAFROM,1,30),"")) D:DA

 ..S X=$$GET1^DIQ(101.43,DA_",",.01)

 ..I X=RAFROM S DIE="^ORD(101.43,",DR=".01///"_RATO_";1.1///"_RATO D ^DIE

 D QUEUE

LIST ;

 ;COMMUNITY CARE IMAGING-CT-AUTO;COMMUNITY CARE-IMAGING CT-AUTO

 ;COMMUNITY CARE IMAGING-MAMMOGRAPHY DIAGNOSTIC-AUTO;COMMUNITY CARE-IMAGING MAMMOGRAPHY DIAGNOSTIC-AUTO

 ;COMMUNITY CARE IMAGING-MAMMOGRAPHY SCREEN-AUTO;COMMUNITY CARE-IMAGING MAMMOGRAPHY SCREEN-AUTO

 ;COMMUNITY CARE IMAGING-MAGNETIC RESONANCE IMAGING-AUTO;COMMUNITY CARE-IMAGING MAGNETIC RESONANCE IMAGING-AUTO

 ;COMMUNITY CARE IMAGING-NUCLEAR MEDICINE-AUTO;COMMUNITY CARE-IMAGING NUCLEAR MEDICINE-AUTO

 ;COMMUNITY CARE IMAGING-GENERAL RADIOLOGY-AUTO;COMMUNITY CARE-IMAGING GENERAL RADIOLOGY-AUTO

 ;COMMUNITY CARE IMAGING-ULTRASOUND-AUTO;COMMUNITY CARE-IMAGING ULTRASOUND-AUTO

;//

QUEUE ;

 N ZTRTN,ZTDESC,ZTREQ,ZTIO,ZTDTH,ZTSK

 D BMES^XPDUTL("Calling TaskMan to create background job to change service name where needed in")

 D BMES^XPDUTL("  Order Actions multiple of file #100")

 S ZTRTN="CHGORAC^RA148PST",ZTDESC="Change service name where needed in Order Actions multiple of file #100",ZTIO="",ZTDTH=$H

 D ^%ZTLOAD I '$G(ZTSK) D BMES^XPDUTL("Unable to create TaskMan job - run CHGORAC^RA148PST after install finishes") Q

 D BMES^XPDUTL("Post-install queued as task #"_$G(ZTSK))

CHGORAC ;

 ;Find orders where the name of the consult might need to be changed in the ORDER ACTIONS multiple

 ;  Example:  "COMMUNITY CARE IMAGING-CT-AUTO"  to  "COMMUNITY CARE-IMAGING CT-AUTO"

 N CT,CTXTMP,CTXTMPPP,DA,IEN,ORACT,ORDATE,ORN,X,X1,X2,XTMP,XTMPPP

 S DA=$$NOW^XLFDT,X1=DA,X2=90 D C^%DTC

 S XTMP=$NA(^XTMP("RA148PST "_$$FMTE^XLFDT(DA,"5PZ")_" "_$J)),(CT,CTXTMP,CTXTMPPP)=0

 K @XTMP S @XTMP@(0)=X_U_DA_U_"List of ORDER ACTION records in file #100 where the name of the consult service was changed"

 S XTMPPP=$NA(^XTMP("RA148PST-PP "_$$FMTE^XLFDT(DA,"5PZ")_" "_$J))

 K @XTMPPP S @XTMPPP@(0)=X_U_DA_U_"Records Pre and Post"

 S ORDATE="3180101" F  S ORDATE=$O(^OR(100,"AF",ORDATE)) Q:'ORDATE  S IEN=0 D

 .F  S IEN=$O(^OR(100,"AF",ORDATE,IEN)) Q:'IEN  D

 ..S ORACT=0 F  S ORACT=$O(^OR(100,"AF",ORDATE,IEN,ORACT)) Q:'ORACT  D

 ...S ORN=0 F  S ORN=$O(^OR(100,IEN,8,ORACT,.1,ORN)) Q:'ORN  S X=^(ORN,0) D CHKORDAC(X)

 S CTXTMP=CTXTMP+1

 I 'CT S @XTMP@(CTXTMP)="No records found that needed changing"

 E  S @XTMP@(CTXTMP)="End of run: "_CT_" record"_$S(CT>1:"s",1:"")_" found and changed"

 S ZTREQ="@"

 K X S X(1)="RA*5.0*148 - the background job has finished changing the consult records."

 I CT=0 S X(2)="No records were changed."

 E  S X(2)=CT_" record"_$S(CT>1:"s were",1:" was")_" changed"

 D MSG(.X)

CHKORDAC(IN) ;

 N FROM,I,OR0,ORPNA,TO,Y,Z

 F I=1:1 S X=$T(LIST+I) Q:X=" ;//"  S FROM=$P(X,";",2),TO=$P(X,";",3) D

 .S Y=$F(IN,FROM) Q:'Y

 .S Z=$E(IN,1,(Y-$L(FROM))-1)_TO_$E(IN,Y,$L(IN))

 .S OR0=$G(^OR(100,IEN,0))

 .I OR0="" S ORPNA="Not Known"

 .E  S ORPNA=$$GET1^DIQ(100,IEN_",",.02,"E")

 .S CT=CT+1,CTXTMP=CTXTMP+1,@XTMP@(CTXTMP)=CT_". "_ORPNA_" Order IEN:"_IEN_" Consult to Service/Specialty changed:"

 .S CTXTMP=CTXTMP+1,@XTMP@(CTXTMP)="  from "_FROM_" to "_TO

 .S CTXTMPPP=CTXTMPPP+1,@XTMPPP@(CTXTMPPP)="^OR(100,"_IEN_",8,"_ORACT_",.1,"_ORN_",0)"

 .S @XTMPPP@(CTXTMPPP,1)=^OR(100,IEN,8,ORACT,.1,ORN,0)

 .S @XTMPPP@(CTXTMPPP,2)=Z

 .S ^OR(100,IEN,8,ORACT,.1,ORN,0)=Z

MSG(SUB) ;create and send message

 N XMDUZ,XMSUB,XMZ,XMTEXT,XMY

 N IEN,A,B,C,LNCNT S (IEN,A,B,C)=0,LNCNT=1

 S XMY(DUZ)=""

 S XMDUZ=DUZ

 S XMSUB="RA*5.0*148 Post-install"

 D XMZ^XMA2 ; call Create Message Module

 S XMTEXT="XMTEXT"

 M XMTEXT=SUB

 D ENL^XMD

 D ENT1^XMD

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRA148PST   4250     printed  Mar 13, 2025@21:37:53                                                                                                                                                                                                    Page 2

RA148PST  ;ABV/MKN - Post Install;10/5/2018 11:28 AM

 +1       ;;5.0;Radiology/Nuclear Medicine;**148**;Mar 16, 1998;Build 59

 +2       ;

 +3        QUIT

 +4       ;

EN        ;

 +1       ;First change the name of the seven -AUTO consult services (files #123.5 and #101.43),

 +2       ;if they exist, to move the hyphen

 +3       ;  Example:  "COMMUNITY CARE IMAGING-CT-AUTO"  to  "COMMUNITY CARE-IMAGING CT-AUTO"

 +4       ;

 +5        NEW DA,DIE,DR,ORN,RAFROM,RAI,RATO,X

 +6        FOR RAI=1:1

               SET X=$TEXT(LIST+RAI)

               if X=" ;//"

                   QUIT

               SET RAFROM=$PIECE(X,";",2)

               SET RATO=$PIECE(X,";",3)

               Begin DoDot:1

 +7                SET DA=$ORDER(^GMR(123.5,"B",RAFROM,""))

                   if DA

                       Begin DoDot:2

 +8                        SET DIE="^GMR(123.5,"

                           SET DR=".01///"_RATO

                           DO ^DIE

                       End DoDot:2

 +9                SET DA=$ORDER(^ORD(101.43,"B",$EXTRACT(RAFROM,1,30),""))

                   if DA

                       Begin DoDot:2

 +10                       SET X=$$GET1^DIQ(101.43,DA_",",.01)

 +11                       IF X=RAFROM

                               SET DIE="^ORD(101.43,"

                               SET DR=".01///"_RATO_";1.1///"_RATO

                               DO ^DIE

                       End DoDot:2

               End DoDot:1

 +12      ;

 +13       DO QUEUE

 +14      ;

 +15       QUIT

 +16      ;

LIST      ;

 +1       ;COMMUNITY CARE IMAGING-CT-AUTO;COMMUNITY CARE-IMAGING CT-AUTO

 +2       ;COMMUNITY CARE IMAGING-MAMMOGRAPHY DIAGNOSTIC-AUTO;COMMUNITY CARE-IMAGING MAMMOGRAPHY DIAGNOSTIC-AUTO

 +3       ;COMMUNITY CARE IMAGING-MAMMOGRAPHY SCREEN-AUTO;COMMUNITY CARE-IMAGING MAMMOGRAPHY SCREEN-AUTO

 +4       ;COMMUNITY CARE IMAGING-MAGNETIC RESONANCE IMAGING-AUTO;COMMUNITY CARE-IMAGING MAGNETIC RESONANCE IMAGING-AUTO

 +5       ;COMMUNITY CARE IMAGING-NUCLEAR MEDICINE-AUTO;COMMUNITY CARE-IMAGING NUCLEAR MEDICINE-AUTO

 +6       ;COMMUNITY CARE IMAGING-GENERAL RADIOLOGY-AUTO;COMMUNITY CARE-IMAGING GENERAL RADIOLOGY-AUTO

 +7       ;COMMUNITY CARE IMAGING-ULTRASOUND-AUTO;COMMUNITY CARE-IMAGING ULTRASOUND-AUTO

 +8       ;//

QUEUE     ;

 +1        NEW ZTRTN,ZTDESC,ZTREQ,ZTIO,ZTDTH,ZTSK

 +2        DO BMES^XPDUTL("Calling TaskMan to create background job to change service name where needed in")

 +3        DO BMES^XPDUTL("  Order Actions multiple of file #100")

 +4        SET ZTRTN="CHGORAC^RA148PST"

           SET ZTDESC="Change service name where needed in Order Actions multiple of file #100"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

 +5        DO ^%ZTLOAD

           IF '$GET(ZTSK)

               DO BMES^XPDUTL("Unable to create TaskMan job - run CHGORAC^RA148PST after install finishes")

               QUIT

 +6        DO BMES^XPDUTL("Post-install queued as task #"_$GET(ZTSK))

 +7        QUIT

 +8       ;

CHGORAC   ;

 +1       ;Find orders where the name of the consult might need to be changed in the ORDER ACTIONS multiple

 +2       ;  Example:  "COMMUNITY CARE IMAGING-CT-AUTO"  to  "COMMUNITY CARE-IMAGING CT-AUTO"

 +3       ;

 +4        NEW CT,CTXTMP,CTXTMPPP,DA,IEN,ORACT,ORDATE,ORN,X,X1,X2,XTMP,XTMPPP

 +5        SET DA=$$NOW^XLFDT

           SET X1=DA

           SET X2=90

           DO C^%DTC

 +6        SET XTMP=$NAME(^XTMP("RA148PST "_$$FMTE^XLFDT(DA,"5PZ")_" "_$JOB))

           SET (CT,CTXTMP,CTXTMPPP)=0

 +7        KILL @XTMP

           SET @XTMP@(0)=X_U_DA_U_"List of ORDER ACTION records in file #100 where the name of the consult service was changed"

 +8        SET XTMPPP=$NAME(^XTMP("RA148PST-PP "_$$FMTE^XLFDT(DA,"5PZ")_" "_$JOB))

 +9        KILL @XTMPPP

           SET @XTMPPP@(0)=X_U_DA_U_"Records Pre and Post"

 +10       SET ORDATE="3180101"

FOR

               SET ORDATE=$ORDER(^OR(100,"AF",ORDATE))

               if 'ORDATE

                   QUIT

               SET IEN=0

               Begin DoDot:1

 +11               FOR

                       SET IEN=$ORDER(^OR(100,"AF",ORDATE,IEN))

                       if 'IEN

                           QUIT

                       Begin DoDot:2

 +12                       SET ORACT=0

FOR

                               SET ORACT=$ORDER(^OR(100,"AF",ORDATE,IEN,ORACT))

                               if 'ORACT

                                   QUIT

                               Begin DoDot:3

 +13                               SET ORN=0

FOR

                                       SET ORN=$ORDER(^OR(100,IEN,8,ORACT,.1,ORN))

                                       if 'ORN

                                           QUIT

                                       SET X=^(ORN,0)

                                       DO CHKORDAC(X)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +14       SET CTXTMP=CTXTMP+1

 +15       IF 'CT

               SET @XTMP@(CTXTMP)="No records found that needed changing"

 +16      IF '$TEST

               SET @XTMP@(CTXTMP)="End of run: "_CT_" record"_$SELECT(CT>1:"s",1:"")_" found and changed"

 +17       SET ZTREQ="@"

 +18       KILL X

           SET X(1)="RA*5.0*148 - the background job has finished changing the consult records."

 +19       IF CT=0

               SET X(2)="No records were changed."

 +20      IF '$TEST

               SET X(2)=CT_" record"_$SELECT(CT>1:"s were",1:" was")_" changed"

 +21       DO MSG(.X)

 +22       QUIT

 +23      ;

CHKORDAC(IN) ;

 +1        NEW FROM,I,OR0,ORPNA,TO,Y,Z

 +2        FOR I=1:1

               SET X=$TEXT(LIST+I)

               if X=" ;//"

                   QUIT

               SET FROM=$PIECE(X,";",2)

               SET TO=$PIECE(X,";",3)

               Begin DoDot:1

 +3                SET Y=$FIND(IN,FROM)

                   if 'Y

                       QUIT

 +4                SET Z=$EXTRACT(IN,1,(Y-$LENGTH(FROM))-1)_TO_$EXTRACT(IN,Y,$LENGTH(IN))

 +5                SET OR0=$GET(^OR(100,IEN,0))

 +6                IF OR0=""

                       SET ORPNA="Not Known"

 +7               IF '$TEST

                       SET ORPNA=$$GET1^DIQ(100,IEN_",",.02,"E")

 +8                SET CT=CT+1

                   SET CTXTMP=CTXTMP+1

                   SET @XTMP@(CTXTMP)=CT_". "_ORPNA_" Order IEN:"_IEN_" Consult to Service/Specialty changed:"

 +9                SET CTXTMP=CTXTMP+1

                   SET @XTMP@(CTXTMP)="  from "_FROM_" to "_TO

 +10               SET CTXTMPPP=CTXTMPPP+1

                   SET @XTMPPP@(CTXTMPPP)="^OR(100,"_IEN_",8,"_ORACT_",.1,"_ORN_",0)"

 +11               SET @XTMPPP@(CTXTMPPP,1)=^OR(100,IEN,8,ORACT,.1,ORN,0)

 +12               SET @XTMPPP@(CTXTMPPP,2)=Z

 +13               SET ^OR(100,IEN,8,ORACT,.1,ORN,0)=Z

               End DoDot:1

 +14       QUIT

 +15      ;

MSG(SUB)  ;create and send message

 +1        NEW XMDUZ,XMSUB,XMZ,XMTEXT,XMY

 +2        NEW IEN,A,B,C,LNCNT

           SET (IEN,A,B,C)=0

           SET LNCNT=1

 +3        SET XMY(DUZ)=""

 +4        SET XMDUZ=DUZ

 +5        SET XMSUB="RA*5.0*148 Post-install"

 +6       ; call Create Message Module

           DO XMZ^XMA2

 +7        SET XMTEXT="XMTEXT"

 +8        MERGE XMTEXT=SUB

 +9        DO ENL^XMD

 +10       DO ENT1^XMD

 +11       QUIT

 +12      ;

RA148PST.m