source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAIPST2.m@ 1203

Last change on this file since 1203 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1RAIPST2 ;HIRMFO/GJC - Post-init number two ;6/16/97 07:59
2VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3EN2 ; 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
20EN3 ; 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
37EN4 ; 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
47EN5 ; 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
68CLEANUP ; 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
85CNVFLG() ; 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
Note: See TracBrowser for help on using the repository browser.