| 1 | RAIPST2 ;HIRMFO/GJC - Post-init number two ;6/16/97  07:59
 | 
|---|
| 2 | VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
 | 
|---|
| 3 | EN2 ; Delete incomplete reports from the Rad/Nuc Med Reports file.
 | 
|---|
| 4 |  ; These reports are deleted because they are incomplete, i.e,
 | 
|---|
| 5 |  ; missing Report Text, missing Impression Text, and a Report
 | 
|---|
| 6 |  ; Status of 'Draft'.  These reports must not have a pointer
 | 
|---|
| 7 |  ; to the Image (2005) file and must not be purged.
 | 
|---|
| 8 |  ; ('PURGE' node must not exist.)
 | 
|---|
| 9 |  ;N RA74,RATXT,RAX,RAY
 | 
|---|
| 10 |  ;S RA74=+$$PARCP^XPDUTL("POST6"),RATXT(1)=" "
 | 
|---|
| 11 |  ;S RATXT(2)="Checking for invalid skeleton reports in the Rad/Nuc Med Reports file."
 | 
|---|
| 12 |  ;S RATXT(3)="If any are found they will be deleted along with all pointers to them."
 | 
|---|
| 13 |  ;S RATXT(4)=" " D MES^XPDUTL(.RATXT)
 | 
|---|
| 14 |  ;F  S RA74=$O(^RARPT(RA74)) Q:RA74'>0  D
 | 
|---|
| 15 |  ;. Q:$D(^RARPT(RA74,"PURGE"))  ; quit if involved in prior purge
 | 
|---|
| 16 |  ;. S RAX=$$EN3^RAUTL15(RA74)
 | 
|---|
| 17 |  ;. S RAY=+$$UPCP^XPDUTL("POST61",RA74)
 | 
|---|
| 18 |  ;. Q
 | 
|---|
| 19 |  Q
 | 
|---|
| 20 | EN3 ; Update the value of the REPORT RIGHT MARGIN of the IMAGING LOCATIONS
 | 
|---|
| 21 |  ; file.
 | 
|---|
| 22 |  Q:$$CNVFLG^RAIPST2()  ; code has been hit in the past.
 | 
|---|
| 23 |  N RA791,RAFDA,RAIEN,RALEFT,RANRIT,RARIT,RATXT S RAIEN=0
 | 
|---|
| 24 |  S RATXT(1)=" "
 | 
|---|
| 25 |  S RATXT(2)="Correcting values in the REPORT RIGHT MARGIN field of all entries in the"
 | 
|---|
| 26 |  S RATXT(3)="IMAGING LOCATIONS file."
 | 
|---|
| 27 |  S RATXT(4)=" " D MES^XPDUTL(.RATXT) K RATXT
 | 
|---|
| 28 |  F  S RAIEN=$O(^RA(79.1,RAIEN)) Q:RAIEN'>0  D
 | 
|---|
| 29 |  . S RA791=$G(^RA(79.1,RAIEN,0))
 | 
|---|
| 30 |  . S RALEFT=+$P(RA791,"^",14),RARIT=+$P(RA791,"^",15)
 | 
|---|
| 31 |  . Q:RALEFT=0!(RARIT=0)  ; cannot perform computations without values
 | 
|---|
| 32 |  . S RANRIT=(RALEFT+RARIT)
 | 
|---|
| 33 |  . S RAFDA(79.1,RAIEN_",",15)=RANRIT
 | 
|---|
| 34 |  . D FILE^DIE("E","RAFDA") K RAFDA,RAERR
 | 
|---|
| 35 |  . Q
 | 
|---|
| 36 |  Q
 | 
|---|
| 37 | EN4 ; Set the 'ASK RADIOPHARMS & DOSAGES?' field (.61) to 'Yes'
 | 
|---|
| 38 |  ; for for the Examinations Status 'EXAMINED' whose Imaging
 | 
|---|
| 39 |  ; Type has the 'RADIOPHARMACEUTICALS USED?' field set to 'Yes'.
 | 
|---|
| 40 |  N I,RAFDA S I=0
 | 
|---|
| 41 |  F  S I=$O(^RA(72,"B","EXAMINED",I)) Q:I'>0  D
 | 
|---|
| 42 |  . N RAITY S RAITY=+$P($G(^RA(72,I,0)),"^",7)
 | 
|---|
| 43 |  . I $$UP^XLFSTR($$GET1^DIQ(79.2,RAITY,5,"I"))="Y" S RAFDA(72,I_",",.61)="Y"
 | 
|---|
| 44 |  . Q
 | 
|---|
| 45 |  D:$D(RAFDA) FILE^DIE("","RAFDA","")
 | 
|---|
| 46 |  Q
 | 
|---|
| 47 | EN5 ; Add 'Mammography' as a new Imaging Type in file 79.2
 | 
|---|
| 48 |  ; Populate the following fields: Operating Conditions
 | 
|---|
| 49 |  ; Abbreviation, Report Cut-Off, Clinical History Cut-Off
 | 
|---|
| 50 |  ; Tracking Time Cut-Off & Order Data Cut-Off
 | 
|---|
| 51 |  Q:$D(^RA(79.2,"B","MAMMOGRAPHY"))\10  ; done in the past
 | 
|---|
| 52 |  N RAFDA K RAERR,RATXT S RATXT(1)=" "
 | 
|---|
| 53 |  S RATXT(2)="Adding 'MAMMOGRAPHY' as a new entry in the Imaging Type file."
 | 
|---|
| 54 |  D MES^XPDUTL(.RATXT) K RATXT
 | 
|---|
| 55 |  S RAFDA(79.2,"+1,",.01)="MAMMOGRAPHY",RAFDA(79.2,"+1,",3)="MAM"
 | 
|---|
| 56 |  S RAFDA(79.2,"+1,",4)="N",RAFDA(79.2,"+1,",.11)=90
 | 
|---|
| 57 |  S RAFDA(79.2,"+1,",.12)=90,RAFDA(79.2,"+1,",.13)=90
 | 
|---|
| 58 |  S RAFDA(79.2,"+1,",.14)=90,RAFDA(79.2,"+1,",.16)=90
 | 
|---|
| 59 |  D UPDATE^DIE("","RAFDA","","RAERR")
 | 
|---|
| 60 |  I $D(RAERR("DIERR")) D
 | 
|---|
| 61 |  . S RATXT(1)=" "
 | 
|---|
| 62 |  . S RATXT(2)="Error filing 'MAMMOGRAPHY' in the Imaging Type (79.2) file."
 | 
|---|
| 63 |  . S RATXT(3)="IRM and the Radiology/Nuclear Medicine ADPAC should investigate."
 | 
|---|
| 64 |  . D MES^XPDUTL(.RATXT)
 | 
|---|
| 65 |  . Q
 | 
|---|
| 66 |  K RAERR,RATXT
 | 
|---|
| 67 |  Q
 | 
|---|
| 68 | CLEANUP ; This entry point is called to queue off the RADIOLOGY/NUCLEAR
 | 
|---|
| 69 |  ; MEDICINE CLEANUP 5.0 build.  This build removes obsolete data and
 | 
|---|
| 70 |  ; fields from the database.
 | 
|---|
| 71 |  N %,DIC,RAPKG,RASTAT,XPDA,X,Y
 | 
|---|
| 72 |  S (RAPKG,X)="RADIOLOGY/NUCLEAR MEDICINE CLEANUP "_$P($T(+2),";",3)
 | 
|---|
| 73 |  S DIC="^XPD(9.7,",DIC(0)="O" D ^DIC Q:+Y'>0  ;cleanup missing
 | 
|---|
| 74 |  S XPDA=+Y
 | 
|---|
| 75 |  S RASTAT=$$GET1^DIQ(9.7,XPDA,.02,"I") ; get status of distribution
 | 
|---|
| 76 |  Q:RASTAT'=0  ; status must be 'loaded from distribution'
 | 
|---|
| 77 |  Q:'$D(^XTMP("XPDI",XPDA,"BLD"))  ; missing from transport global
 | 
|---|
| 78 |  N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE S ZTIO=""
 | 
|---|
| 79 |  S ZTRTN="EN^XPDIJ",ZTDESC="Rad/Nuc Med Cleanup 5.0 task"
 | 
|---|
| 80 |  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,2,0),ZTSAVE("XPDA")=""
 | 
|---|
| 81 |  D ^%ZTLOAD N RATXT S RATXT(1)=" "
 | 
|---|
| 82 |  S RATXT(2)=RAPKG_" is running in background."
 | 
|---|
| 83 |  S:$G(ZTSK)>0 RATXT(3)="Task: "_ZTSK_"." D MES^XPDUTL(.RATXT)
 | 
|---|
| 84 |  Q
 | 
|---|
| 85 | CNVFLG() ; This code checks to see if the Right Margin field for the
 | 
|---|
| 86 |  ; Imaging Locations file has had its data converted by a prior install
 | 
|---|
| 87 |  ; of Rad/Nuc Med v5.  We check to see if the 'ASK RADIOPHARMS &
 | 
|---|
| 88 |  ; DOSAGES?' field (.61) is set to 'Yes'.  If so, the post-init must
 | 
|---|
| 89 |  ; have run in the past.
 | 
|---|
| 90 |  ;
 | 
|---|
| 91 |  ; Returns: '0' if initial post-init run, '1' if the post-init has run
 | 
|---|
| 92 |  ;          in the past.
 | 
|---|
| 93 |  ;
 | 
|---|
| 94 |  N I,RAFLG S (I,RAFLG)=0
 | 
|---|
| 95 |  F  S I=$O(^RA(72,"B","EXAMINED",I)) Q:I'>0  D  Q:RAFLG
 | 
|---|
| 96 |  . S:$$UP^XLFSTR($P($G(^RA(72,I,.6)),"^"))="Y" RAFLG=1
 | 
|---|
| 97 |  . Q
 | 
|---|
| 98 |  Q RAFLG
 | 
|---|