RA148PST ;ABV/MKN - Post Install;10/5/2018 11:28 AM
;;5.0;Radiology/Nuclear Medicine;**148**;Mar 16, 1998;Build 59
;
Q
;
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
;
Q
;
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))
Q
;
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)
Q
;
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
Q
;
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
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRA148PST 4250 printed Dec 13, 2024@02:33:08 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 ;
