RAIPST2 ;HIRMFO/GJC - Post-init number two ;6/16/97 07:59
VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
EN2 ; Delete incomplete reports from the Rad/Nuc Med Reports file.
; These reports are deleted because they are incomplete, i.e,
; missing Report Text, missing Impression Text, and a Report
; Status of 'Draft'. These reports must not have a pointer
; to the Image (2005) file and must not be purged.
; ('PURGE' node must not exist.)
;N RA74,RATXT,RAX,RAY
;S RA74=+$$PARCP^XPDUTL("POST6"),RATXT(1)=" "
;S RATXT(2)="Checking for invalid skeleton reports in the Rad/Nuc Med Reports file."
;S RATXT(3)="If any are found they will be deleted along with all pointers to them."
;S RATXT(4)=" " D MES^XPDUTL(.RATXT)
;F S RA74=$O(^RARPT(RA74)) Q:RA74'>0 D
;. Q:$D(^RARPT(RA74,"PURGE")) ; quit if involved in prior purge
;. S RAX=$$EN3^RAUTL15(RA74)
;. S RAY=+$$UPCP^XPDUTL("POST61",RA74)
;. Q
Q
EN3 ; Update the value of the REPORT RIGHT MARGIN of the IMAGING LOCATIONS
; file.
Q:$$CNVFLG^RAIPST2() ; code has been hit in the past.
N RA791,RAFDA,RAIEN,RALEFT,RANRIT,RARIT,RATXT S RAIEN=0
S RATXT(1)=" "
S RATXT(2)="Correcting values in the REPORT RIGHT MARGIN field of all entries in the"
S RATXT(3)="IMAGING LOCATIONS file."
S RATXT(4)=" " D MES^XPDUTL(.RATXT) K RATXT
F S RAIEN=$O(^RA(79.1,RAIEN)) Q:RAIEN'>0 D
. S RA791=$G(^RA(79.1,RAIEN,0))
. S RALEFT=+$P(RA791,"^",14),RARIT=+$P(RA791,"^",15)
. Q:RALEFT=0!(RARIT=0) ; cannot perform computations without values
. S RANRIT=(RALEFT+RARIT)
. S RAFDA(79.1,RAIEN_",",15)=RANRIT
. D FILE^DIE("E","RAFDA") K RAFDA,RAERR
. Q
Q
EN4 ; Set the 'ASK RADIOPHARMS & DOSAGES?' field (.61) to 'Yes'
; for for the Examinations Status 'EXAMINED' whose Imaging
; Type has the 'RADIOPHARMACEUTICALS USED?' field set to 'Yes'.
N I,RAFDA S I=0
F S I=$O(^RA(72,"B","EXAMINED",I)) Q:I'>0 D
. N RAITY S RAITY=+$P($G(^RA(72,I,0)),"^",7)
. I $$UP^XLFSTR($$GET1^DIQ(79.2,RAITY,5,"I"))="Y" S RAFDA(72,I_",",.61)="Y"
. Q
D:$D(RAFDA) FILE^DIE("","RAFDA","")
Q
EN5 ; Add 'Mammography' as a new Imaging Type in file 79.2
; Populate the following fields: Operating Conditions
; Abbreviation, Report Cut-Off, Clinical History Cut-Off
; Tracking Time Cut-Off & Order Data Cut-Off
Q:$D(^RA(79.2,"B","MAMMOGRAPHY"))\10 ; done in the past
N RAFDA K RAERR,RATXT S RATXT(1)=" "
S RATXT(2)="Adding 'MAMMOGRAPHY' as a new entry in the Imaging Type file."
D MES^XPDUTL(.RATXT) K RATXT
S RAFDA(79.2,"+1,",.01)="MAMMOGRAPHY",RAFDA(79.2,"+1,",3)="MAM"
S RAFDA(79.2,"+1,",4)="N",RAFDA(79.2,"+1,",.11)=90
S RAFDA(79.2,"+1,",.12)=90,RAFDA(79.2,"+1,",.13)=90
S RAFDA(79.2,"+1,",.14)=90,RAFDA(79.2,"+1,",.16)=90
D UPDATE^DIE("","RAFDA","","RAERR")
I $D(RAERR("DIERR")) D
. S RATXT(1)=" "
. S RATXT(2)="Error filing 'MAMMOGRAPHY' in the Imaging Type (79.2) file."
. S RATXT(3)="IRM and the Radiology/Nuclear Medicine ADPAC should investigate."
. D MES^XPDUTL(.RATXT)
. Q
K RAERR,RATXT
Q
CLEANUP ; This entry point is called to queue off the RADIOLOGY/NUCLEAR
; MEDICINE CLEANUP 5.0 build. This build removes obsolete data and
; fields from the database.
N %,DIC,RAPKG,RASTAT,XPDA,X,Y
S (RAPKG,X)="RADIOLOGY/NUCLEAR MEDICINE CLEANUP "_$P($T(+2),";",3)
S DIC="^XPD(9.7,",DIC(0)="O" D ^DIC Q:+Y'>0 ;cleanup missing
S XPDA=+Y
S RASTAT=$$GET1^DIQ(9.7,XPDA,.02,"I") ; get status of distribution
Q:RASTAT'=0 ; status must be 'loaded from distribution'
Q:'$D(^XTMP("XPDI",XPDA,"BLD")) ; missing from transport global
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE S ZTIO=""
S ZTRTN="EN^XPDIJ",ZTDESC="Rad/Nuc Med Cleanup 5.0 task"
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,2,0),ZTSAVE("XPDA")=""
D ^%ZTLOAD N RATXT S RATXT(1)=" "
S RATXT(2)=RAPKG_" is running in background."
S:$G(ZTSK)>0 RATXT(3)="Task: "_ZTSK_"." D MES^XPDUTL(.RATXT)
Q
CNVFLG() ; This code checks to see if the Right Margin field for the
; Imaging Locations file has had its data converted by a prior install
; of Rad/Nuc Med v5. We check to see if the 'ASK RADIOPHARMS &
; DOSAGES?' field (.61) is set to 'Yes'. If so, the post-init must
; have run in the past.
;
; Returns: '0' if initial post-init run, '1' if the post-init has run
; in the past.
;
N I,RAFLG S (I,RAFLG)=0
F S I=$O(^RA(72,"B","EXAMINED",I)) Q:I'>0 D Q:RAFLG
. S:$$UP^XLFSTR($P($G(^RA(72,I,.6)),"^"))="Y" RAFLG=1
. Q
Q RAFLG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPST2 4464 printed Dec 13, 2024@02:36:29 Page 2
RAIPST2 ;HIRMFO/GJC - Post-init number two ;6/16/97 07:59
VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
EN2 ; Delete incomplete reports from the Rad/Nuc Med Reports file.
+1 ; These reports are deleted because they are incomplete, i.e,
+2 ; missing Report Text, missing Impression Text, and a Report
+3 ; Status of 'Draft'. These reports must not have a pointer
+4 ; to the Image (2005) file and must not be purged.
+5 ; ('PURGE' node must not exist.)
+6 ;N RA74,RATXT,RAX,RAY
+7 ;S RA74=+$$PARCP^XPDUTL("POST6"),RATXT(1)=" "
+8 ;S RATXT(2)="Checking for invalid skeleton reports in the Rad/Nuc Med Reports file."
+9 ;S RATXT(3)="If any are found they will be deleted along with all pointers to them."
+10 ;S RATXT(4)=" " D MES^XPDUTL(.RATXT)
+11 ;F S RA74=$O(^RARPT(RA74)) Q:RA74'>0 D
+12 ;. Q:$D(^RARPT(RA74,"PURGE")) ; quit if involved in prior purge
+13 ;. S RAX=$$EN3^RAUTL15(RA74)
+14 ;. S RAY=+$$UPCP^XPDUTL("POST61",RA74)
+15 ;. Q
+16 QUIT
EN3 ; Update the value of the REPORT RIGHT MARGIN of the IMAGING LOCATIONS
+1 ; file.
+2 ; code has been hit in the past.
if $$CNVFLG^RAIPST2()
QUIT
+3 NEW RA791,RAFDA,RAIEN,RALEFT,RANRIT,RARIT,RATXT
SET RAIEN=0
+4 SET RATXT(1)=" "
+5 SET RATXT(2)="Correcting values in the REPORT RIGHT MARGIN field of all entries in the"
+6 SET RATXT(3)="IMAGING LOCATIONS file."
+7 SET RATXT(4)=" "
DO MES^XPDUTL(.RATXT)
KILL RATXT
+8 FOR
SET RAIEN=$ORDER(^RA(79.1,RAIEN))
if RAIEN'>0
QUIT
Begin DoDot:1
+9 SET RA791=$GET(^RA(79.1,RAIEN,0))
+10 SET RALEFT=+$PIECE(RA791,"^",14)
SET RARIT=+$PIECE(RA791,"^",15)
+11 ; cannot perform computations without values
if RALEFT=0!(RARIT=0)
QUIT
+12 SET RANRIT=(RALEFT+RARIT)
+13 SET RAFDA(79.1,RAIEN_",",15)=RANRIT
+14 DO FILE^DIE("E","RAFDA")
KILL RAFDA,RAERR
+15 QUIT
End DoDot:1
+16 QUIT
EN4 ; Set the 'ASK RADIOPHARMS & DOSAGES?' field (.61) to 'Yes'
+1 ; for for the Examinations Status 'EXAMINED' whose Imaging
+2 ; Type has the 'RADIOPHARMACEUTICALS USED?' field set to 'Yes'.
+3 NEW I,RAFDA
SET I=0
+4 FOR
SET I=$ORDER(^RA(72,"B","EXAMINED",I))
if I'>0
QUIT
Begin DoDot:1
+5 NEW RAITY
SET RAITY=+$PIECE($GET(^RA(72,I,0)),"^",7)
+6 IF $$UP^XLFSTR($$GET1^DIQ(79.2,RAITY,5,"I"))="Y"
SET RAFDA(72,I_",",.61)="Y"
+7 QUIT
End DoDot:1
+8 if $DATA(RAFDA)
DO FILE^DIE("","RAFDA","")
+9 QUIT
EN5 ; Add 'Mammography' as a new Imaging Type in file 79.2
+1 ; Populate the following fields: Operating Conditions
+2 ; Abbreviation, Report Cut-Off, Clinical History Cut-Off
+3 ; Tracking Time Cut-Off & Order Data Cut-Off
+4 ; done in the past
if $DATA(^RA(79.2,"B","MAMMOGRAPHY"))\10
QUIT
+5 NEW RAFDA
KILL RAERR,RATXT
SET RATXT(1)=" "
+6 SET RATXT(2)="Adding 'MAMMOGRAPHY' as a new entry in the Imaging Type file."
+7 DO MES^XPDUTL(.RATXT)
KILL RATXT
+8 SET RAFDA(79.2,"+1,",.01)="MAMMOGRAPHY"
SET RAFDA(79.2,"+1,",3)="MAM"
+9 SET RAFDA(79.2,"+1,",4)="N"
SET RAFDA(79.2,"+1,",.11)=90
+10 SET RAFDA(79.2,"+1,",.12)=90
SET RAFDA(79.2,"+1,",.13)=90
+11 SET RAFDA(79.2,"+1,",.14)=90
SET RAFDA(79.2,"+1,",.16)=90
+12 DO UPDATE^DIE("","RAFDA","","RAERR")
+13 IF $DATA(RAERR("DIERR"))
Begin DoDot:1
+14 SET RATXT(1)=" "
+15 SET RATXT(2)="Error filing 'MAMMOGRAPHY' in the Imaging Type (79.2) file."
+16 SET RATXT(3)="IRM and the Radiology/Nuclear Medicine ADPAC should investigate."
+17 DO MES^XPDUTL(.RATXT)
+18 QUIT
End DoDot:1
+19 KILL RAERR,RATXT
+20 QUIT
CLEANUP ; This entry point is called to queue off the RADIOLOGY/NUCLEAR
+1 ; MEDICINE CLEANUP 5.0 build. This build removes obsolete data and
+2 ; fields from the database.
+3 NEW %,DIC,RAPKG,RASTAT,XPDA,X,Y
+4 SET (RAPKG,X)="RADIOLOGY/NUCLEAR MEDICINE CLEANUP "_$PIECE($TEXT(+2),";",3)
+5 ;cleanup missing
SET DIC="^XPD(9.7,"
SET DIC(0)="O"
DO ^DIC
if +Y'>0
QUIT
+6 SET XPDA=+Y
+7 ; get status of distribution
SET RASTAT=$$GET1^DIQ(9.7,XPDA,.02,"I")
+8 ; status must be 'loaded from distribution'
if RASTAT'=0
QUIT
+9 ; missing from transport global
if '$DATA(^XTMP("XPDI",XPDA,"BLD"))
QUIT
+10 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
SET ZTIO=""
+11 SET ZTRTN="EN^XPDIJ"
SET ZTDESC="Rad/Nuc Med Cleanup 5.0 task"
+12 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,2,0)
SET ZTSAVE("XPDA")=""
+13 DO ^%ZTLOAD
NEW RATXT
SET RATXT(1)=" "
+14 SET RATXT(2)=RAPKG_" is running in background."
+15 if $GET(ZTSK)>0
SET RATXT(3)="Task: "_ZTSK_"."
DO MES^XPDUTL(.RATXT)
+16 QUIT
CNVFLG() ; This code checks to see if the Right Margin field for the
+1 ; Imaging Locations file has had its data converted by a prior install
+2 ; of Rad/Nuc Med v5. We check to see if the 'ASK RADIOPHARMS &
+3 ; DOSAGES?' field (.61) is set to 'Yes'. If so, the post-init must
+4 ; have run in the past.
+5 ;
+6 ; Returns: '0' if initial post-init run, '1' if the post-init has run
+7 ; in the past.
+8 ;
+9 NEW I,RAFLG
SET (I,RAFLG)=0
+10 FOR
SET I=$ORDER(^RA(72,"B","EXAMINED",I))
if I'>0
QUIT
Begin DoDot:1
+11 if $$UP^XLFSTR($PIECE($GET(^RA(72,I,.6)),"^"))="Y"
SET RAFLG=1
+12 QUIT
End DoDot:1
if RAFLG
QUIT
+13 QUIT RAFLG
