| [613] | 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
|
|---|
