- RA27LIST ;HIRMFO/SWM - List data after RA27PST ;12/21/01 11:10
- VERSION ;;5.0;Radiology/Nuclear Medicine;**27**;Mar 16, 1998
- ; Use this AFTER RA27PST has finished to
- ; list report-to-exam pointer problems, from ^XTMP("RA-RA27PST) :
- ; Orphan report's impression, report text
- ; Exam's report's impression, report text
- ;
- ; A74= ien file 74 from 1st paired record
- ; B74= ien file 74 from 2nd paired record
- ; RA7003 = exam global node name
- EN I '$O(^XTMP("RA-RA27PST",.99)) W !!,"There's no data warning in ^XTMP(""RA-RA27PST"", -- nothing done --" Q
- 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
- 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."
- 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."
- W !!,"The listing may be sent directly to the screen, or to a device.",!
- DEV K %ZIS,IOP W ! S %ZIS="QM",%ZIS("A")="Select a device: "
- D ^%ZIS I POP G QOUT
- I '$D(IO("Q")) D START G QOUT
- S ZTRTN="START^RA27LIST",ZTSAVE("RAY")=""
- S ZTDESC="Checking results from ^XTMP(""RA-RA27PST"""
- D ^%ZTLOAD
- I +$G(ZTSK("D"))>0 W !?2,"Request Queued, Task #: ",$G(ZTSK)
- D HOME^%ZIS K IO("Q")
- QOUT S:$D(ZTQUEUED) ZTREQ="@"
- W ! D ^%ZISC
- Q
- START U IO
- W !,"Patch RA*5*27's post-install routine that was run on ",RAY,!,"has found reports that are NOT linked to any exams."
- 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.",!
- S I=.99
- 1 S I=$O(^XTMP("RA-RA27PST",I)) Q:'I
- K X1,X2
- G:I#1'=0 1 ;first node of pair must be integer
- G:^XTMP("RA-RA27PST",I)["locked" 1 S X1=^(I)
- S A74=$P(X1,"ien=",2),A74=$P(A74," but")
- S I2=$O(^XTMP("RA-RA27PST",I)) G:(I2'=(I+.1)) 1 S X2=^(I2),I=I2
- S B74=$P(X2,"piece=",2)
- S RA7003=$P(X2,"'s"),RA7003=$E(RA7003,2,$L(RA7003))
- S HIST=$P(RA7003,",0)"),HIST=HIST_",""H"","
- W !!,"============================================================================"
- W !,"_____Orphan report_____ ",$P($G(^RARPT(A74,0)),"^"),": ",?60,"^RARPT(",A74
- D GETDEM(A74)
- W !?2,"RptStatus=",$P(^RARPT(A74,0),"^",5) W:$D(^(2005)) ", has Images"
- 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)) ", "
- W !,"Orphan's report impression:"
- S J=0 F S J=$O(^RARPT(A74,"I",J)) Q:'J W !?2,^(J,0)
- W !,"Orphan's report text:"
- S J=0 F S J=$O(^RARPT(A74,"R",J)) Q:'J W !?2,^(J,0)
- W !,"_____Exam's report_____ ",$S(+B74:$P(^RARPT(B74,0),"^"),1:"**Exam is not linked to a report**"),": " W:+B74 ?60,"^RARPT(",B74
- D:+B74 GETDEM(B74)
- I +B74 D
- . W !?2,"RptStatus=",$P(^RARPT(B74,0),"^",5) W:$D(^(2005)) ", has Images"
- . 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)) ", "
- W !,"Clinical History from exam:"
- S J=0 F S J=$O(@(HIST_J_")")) Q:'J W !?2,@(HIST_J_",0)")
- I +B74 D
- . W !,"Exam's report impression:"
- . S J=0 F S J=$O(^RARPT(B74,"I",J)) Q:'J W !?2,^(J,0)
- . W !,"Exam's report text:"
- . S J=0 F S J=$O(^RARPT(B74,"R",J)) Q:'J W !?2,^(J,0)
- G 1
- GETDEM(X) ;
- Q:'$D(^RARPT(X,0))
- S RADFN=+$P($G(^RARPT(X,0)),"^",2),RADT=$P($G(^(0)),"^",3),RAPNAM="UNKNOWN",RAPSSN="UNKNOWN"
- S:RADFN RAPNAM=$$GET1^DIQ(70,RADFN,.01),RAPSSN=$$GET1^DIQ(70,RADFN,.09)
- W !,"Patient: ",RAPNAM," SSN: ",RAPSSN
- W " Exm D/T: ",$E(RADT,4,5),"/",$E(RADT,6,7),"/",$E(RADT,2,3),"@",$E(RADT,9,10),":",$E(RADT,11,12)
- Q
- RA27LIST ;HIRMFO/SWM - List data after RA27PST ;12/21/01 11:10
- VERSION ;;5.0;Radiology/Nuclear Medicine;**27**;Mar 16, 1998
- +1 ; Use this AFTER RA27PST has finished to
- +2 ; list report-to-exam pointer problems, from ^XTMP("RA-RA27PST) :
- +3 ; Orphan report's impression, report text
- +4 ; Exam's report's impression, report text
- +5 ;
- +6 ; A74= ien file 74 from 1st paired record
- +7 ; B74= ien file 74 from 2nd paired record
- +8 ; RA7003 = exam global node name
- EN IF '$ORDER(^XTMP("RA-RA27PST",.99))
- WRITE !!,"There's no data warning in ^XTMP(""RA-RA27PST"", -- nothing done --"
- QUIT
- +1 WRITE !,"The post-install cleanup from patch RA*5.0*27 was tasked off ",!,"on "
- SET Y=$PIECE(^XTMP("RA-RA27PST",0),"^",2)
- DO DD^%DT
- WRITE Y
- SET RAY=Y
- +2 WRITE " 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."
- +3 WRITE !!,"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."
- +4 WRITE !!,"The listing may be sent directly to the screen, or to a device.",!
- DEV KILL %ZIS,IOP
- WRITE !
- SET %ZIS="QM"
- SET %ZIS("A")="Select a device: "
- +1 DO ^%ZIS
- IF POP
- GOTO QOUT
- +2 IF '$DATA(IO("Q"))
- DO START
- GOTO QOUT
- +3 SET ZTRTN="START^RA27LIST"
- SET ZTSAVE("RAY")=""
- +4 SET ZTDESC="Checking results from ^XTMP(""RA-RA27PST"""
- +5 DO ^%ZTLOAD
- +6 IF +$GET(ZTSK("D"))>0
- WRITE !?2,"Request Queued, Task #: ",$GET(ZTSK)
- +7 DO HOME^%ZIS
- KILL IO("Q")
- QOUT IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 WRITE !
- DO ^%ZISC
- +2 QUIT
- START USE IO
- +1 WRITE !,"Patch RA*5*27's post-install routine that was run on ",RAY,!,"has found reports that are NOT linked to any exams."
- +2 WRITE !!,"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.",!
- +3 SET I=.99
- 1 SET I=$ORDER(^XTMP("RA-RA27PST",I))
- IF 'I
- QUIT
- +1 KILL X1,X2
- +2 ;first node of pair must be integer
- IF I#1'=0
- GOTO 1
- +3 IF ^XTMP("RA-RA27PST",I)["locked"
- GOTO 1
- SET X1=^(I)
- +4 SET A74=$PIECE(X1,"ien=",2)
- SET A74=$PIECE(A74," but")
- +5 SET I2=$ORDER(^XTMP("RA-RA27PST",I))
- IF (I2'=(I+.1))
- GOTO 1
- SET X2=^(I2)
- SET I=I2
- +6 SET B74=$PIECE(X2,"piece=",2)
- +7 SET RA7003=$PIECE(X2,"'s")
- SET RA7003=$EXTRACT(RA7003,2,$LENGTH(RA7003))
- +8 SET HIST=$PIECE(RA7003,",0)")
- SET HIST=HIST_",""H"","
- +9 WRITE !!,"============================================================================"
- +10 WRITE !,"_____Orphan report_____ ",$PIECE($GET(^RARPT(A74,0)),"^"),": ",?60,"^RARPT(",A74
- +11 DO GETDEM(A74)
- +12 WRITE !?2,"RptStatus=",$PIECE(^RARPT(A74,0),"^",5)
- IF $DATA(^(2005))
- WRITE ", has Images"
- +13 IF $DATA(^(1))
- WRITE !?2,"Share rpt with case#: "
- SET J=""
- FOR
- SET J=$ORDER(^RARPT(A74,1,"B",J))
- IF J=""
- QUIT
- WRITE $PIECE(J,"-",2)
- IF $ORDER(^RARPT(A74,1,"B",J))
- WRITE ", "
- +14 WRITE !,"Orphan's report impression:"
- +15 SET J=0
- FOR
- SET J=$ORDER(^RARPT(A74,"I",J))
- IF 'J
- QUIT
- WRITE !?2,^(J,0)
- +16 WRITE !,"Orphan's report text:"
- +17 SET J=0
- FOR
- SET J=$ORDER(^RARPT(A74,"R",J))
- IF 'J
- QUIT
- WRITE !?2,^(J,0)
- +18 WRITE !,"_____Exam's report_____ ",$SELECT(+B74:$PIECE(^RARPT(B74,0),"^"),1:"**Exam is not linked to a report**"),": "
- IF +B74
- WRITE ?60,"^RARPT(",B74
- +19 IF +B74
- DO GETDEM(B74)
- +20 IF +B74
- Begin DoDot:1
- +21 WRITE !?2,"RptStatus=",$PIECE(^RARPT(B74,0),"^",5)
- IF $DATA(^(2005))
- WRITE ", has Images"
- +22 IF $DATA(^(1))
- WRITE !?2,"Share rpt with case#: "
- SET J=""
- FOR
- SET J=$ORDER(^RARPT(B74,1,"B",J))
- IF J=""
- QUIT
- WRITE $PIECE(J,"-",2)
- IF $ORDER(^RARPT(B74,1,"B",J))
- WRITE ", "
- End DoDot:1
- +23 WRITE !,"Clinical History from exam:"
- +24 SET J=0
- FOR
- SET J=$ORDER(@(HIST_J_")"))
- IF 'J
- QUIT
- WRITE !?2,@(HIST_J_",0)")
- +25 IF +B74
- Begin DoDot:1
- +26 WRITE !,"Exam's report impression:"
- +27 SET J=0
- FOR
- SET J=$ORDER(^RARPT(B74,"I",J))
- IF 'J
- QUIT
- WRITE !?2,^(J,0)
- +28 WRITE !,"Exam's report text:"
- +29 SET J=0
- FOR
- SET J=$ORDER(^RARPT(B74,"R",J))
- IF 'J
- QUIT
- WRITE !?2,^(J,0)
- End DoDot:1
- +30 GOTO 1
- GETDEM(X) ;
- +1 IF '$DATA(^RARPT(X,0))
- QUIT
- +2 SET RADFN=+$PIECE($GET(^RARPT(X,0)),"^",2)
- SET RADT=$PIECE($GET(^(0)),"^",3)
- SET RAPNAM="UNKNOWN"
- SET RAPSSN="UNKNOWN"
- +3 IF RADFN
- SET RAPNAM=$$GET1^DIQ(70,RADFN,.01)
- SET RAPSSN=$$GET1^DIQ(70,RADFN,.09)
- +4 WRITE !,"Patient: ",RAPNAM," SSN: ",RAPSSN
- +5 WRITE " Exm D/T: ",$EXTRACT(RADT,4,5),"/",$EXTRACT(RADT,6,7),"/",$EXTRACT(RADT,2,3),"@",$EXTRACT(RADT,9,10),":",$EXTRACT(RADT,11,12)
- +6 QUIT
