source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RA27LIST.m@ 808

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1RA27LIST ;HIRMFO/SWM - List data after RA27PST ;12/21/01 11:10
2VERSION ;;5.0;Radiology/Nuclear Medicine;**27**;Mar 16, 1998
3 ; Use this AFTER RA27PST has finished to
4 ; list report-to-exam pointer problems, from ^XTMP("RA-RA27PST) :
5 ; Orphan report's impression, report text
6 ; Exam's report's impression, report text
7 ;
8 ; A74= ien file 74 from 1st paired record
9 ; B74= ien file 74 from 2nd paired record
10 ; RA7003 = exam global node name
11EN I '$O(^XTMP("RA-RA27PST",.99)) W !!,"There's no data warning in ^XTMP(""RA-RA27PST"", -- nothing done --" Q
12 W !,"The post-install cleanup from patch RA*5.0*27 was tasked off ",!,"on " S Y=$P(^XTMP("RA-RA27PST",0),"^",2) D DD^%DT W Y S RAY=Y
13 W " This routine reads the cleanup's results,",!,"which are stored in ^XTMP(""RA-RA27PST"". The results contain the report",!,"IDs for reports that couldn't have their duplicate Clinical History purged."
14 W !!,"This routine outputs a listing of orphaned reports and the exams that",!,"they refer to. This listing may be used by the Radiology and IRM staff",!,"to determine if an orphan report is valid or not."
15 W !!,"The listing may be sent directly to the screen, or to a device.",!
16DEV K %ZIS,IOP W ! S %ZIS="QM",%ZIS("A")="Select a device: "
17 D ^%ZIS I POP G QOUT
18 I '$D(IO("Q")) D START G QOUT
19 S ZTRTN="START^RA27LIST",ZTSAVE("RAY")=""
20 S ZTDESC="Checking results from ^XTMP(""RA-RA27PST"""
21 D ^%ZTLOAD
22 I +$G(ZTSK("D"))>0 W !?2,"Request Queued, Task #: ",$G(ZTSK)
23 D HOME^%ZIS K IO("Q")
24QOUT S:$D(ZTQUEUED) ZTREQ="@"
25 W ! D ^%ZISC
26 Q
27START U IO
28 W !,"Patch RA*5*27's post-install routine that was run on ",RAY,!,"has found reports that are NOT linked to any exams."
29 W !!,"The following listing shows the orphan report (not linked to any exam),",!,"the clinical history of the exam that the orphan refers to, and the exam's",!,"currently linked report, if any.",!
30 S I=.99
311 S I=$O(^XTMP("RA-RA27PST",I)) Q:'I
32 K X1,X2
33 G:I#1'=0 1 ;first node of pair must be integer
34 G:^XTMP("RA-RA27PST",I)["locked" 1 S X1=^(I)
35 S A74=$P(X1,"ien=",2),A74=$P(A74," but")
36 S I2=$O(^XTMP("RA-RA27PST",I)) G:(I2'=(I+.1)) 1 S X2=^(I2),I=I2
37 S B74=$P(X2,"piece=",2)
38 S RA7003=$P(X2,"'s"),RA7003=$E(RA7003,2,$L(RA7003))
39 S HIST=$P(RA7003,",0)"),HIST=HIST_",""H"","
40 W !!,"============================================================================"
41 W !,"_____Orphan report_____ ",$P($G(^RARPT(A74,0)),"^"),": ",?60,"^RARPT(",A74
42 D GETDEM(A74)
43 W !?2,"RptStatus=",$P(^RARPT(A74,0),"^",5) W:$D(^(2005)) ", has Images"
44 I $D(^(1)) W !?2,"Share rpt with case#: " S J="" F S J=$O(^RARPT(A74,1,"B",J)) Q:J="" W $P(J,"-",2) W:$O(^RARPT(A74,1,"B",J)) ", "
45 W !,"Orphan's report impression:"
46 S J=0 F S J=$O(^RARPT(A74,"I",J)) Q:'J W !?2,^(J,0)
47 W !,"Orphan's report text:"
48 S J=0 F S J=$O(^RARPT(A74,"R",J)) Q:'J W !?2,^(J,0)
49 W !,"_____Exam's report_____ ",$S(+B74:$P(^RARPT(B74,0),"^"),1:"**Exam is not linked to a report**"),": " W:+B74 ?60,"^RARPT(",B74
50 D:+B74 GETDEM(B74)
51 I +B74 D
52 . W !?2,"RptStatus=",$P(^RARPT(B74,0),"^",5) W:$D(^(2005)) ", has Images"
53 . I $D(^(1)) W !?2,"Share rpt with case#: " S J="" F S J=$O(^RARPT(B74,1,"B",J)) Q:J="" W $P(J,"-",2) W:$O(^RARPT(B74,1,"B",J)) ", "
54 W !,"Clinical History from exam:"
55 S J=0 F S J=$O(@(HIST_J_")")) Q:'J W !?2,@(HIST_J_",0)")
56 I +B74 D
57 . W !,"Exam's report impression:"
58 . S J=0 F S J=$O(^RARPT(B74,"I",J)) Q:'J W !?2,^(J,0)
59 . W !,"Exam's report text:"
60 . S J=0 F S J=$O(^RARPT(B74,"R",J)) Q:'J W !?2,^(J,0)
61 G 1
62GETDEM(X) ;
63 Q:'$D(^RARPT(X,0))
64 S RADFN=+$P($G(^RARPT(X,0)),"^",2),RADT=$P($G(^(0)),"^",3),RAPNAM="UNKNOWN",RAPSSN="UNKNOWN"
65 S:RADFN RAPNAM=$$GET1^DIQ(70,RADFN,.01),RAPSSN=$$GET1^DIQ(70,RADFN,.09)
66 W !,"Patient: ",RAPNAM," SSN: ",RAPSSN
67 W " Exm D/T: ",$E(RADT,4,5),"/",$E(RADT,6,7),"/",$E(RADT,2,3),"@",$E(RADT,9,10),":",$E(RADT,11,12)
68 Q
Note: See TracBrowser for help on using the repository browser.