- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTE1.m
r613 r623 1 RARTE1 ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Edit/Delete a Report ;6/10/98 16:08 2 ;;5.0;Radiology/Nuclear Medicine;**2,15,17,23,31,68,56**;Mar 16, 1998;Build 3 3 ;Private IA #4793 DELETE^WVRALINK, CREATE^WVRALINK 4 ;Supported IA #10035 5 ;Supported IA #10007 6 ;11/07/2005 KAM/BAY 110020 - Correct DUZ ID from Talk Technology 7 ; During the Unverify process 8 DEL D SET^RAPSET1 I $D(XQUIT) K XQUIT Q 9 S (RAPRG74,RAXIT)=0 10 S DIC("A")="Select Report Day-Case#: " 11 S DIC("W")="S RA0=^(0) W "" "",$S($D(^DPT(+$P(RA0,""^"",2),0)):$P(^(0),""^""),1:""Unknown"") K RA0 W "" "",$$FLD^RARTFLDS(+Y,""PROC"")" 12 S DIC("S")="I $P(^(0),U,5)'=""X""" ;select only non-deleted reports 13 S DIC="^RARPT(",DIC(0)="AEMQZ" D ^DIC K DIC G END:Y<0 14 S RA0=Y(0),(DA,RAIEN)=+Y 15 I $O(^RARPT(RAIEN,2005,0)) D D END Q 16 . W !!?5,"Cannot delete a report that is associated with an image." 17 . W !?5,"Contact your Imaging Coordinator for further assistance.",! 18 . S DIR(0)="E",DIR("A")="Press RETURN to continue" 19 . D ^DIR K DIR,DIRUT,DUOUT 20 . Q ;08/23/00 21 D CHK17^RARTE3 ;see this subroutine for values of RAOK 22 G:RAOK=1 END ;can't del rpt w/o RACN or RACNI so avoid err at UP1^RAUTL1 23 S RAXIT=$$LOCK^RAUTL12("^RARPT(",RAIEN) 24 I RAXIT K RAXIT D END Q ; record locked by another 25 ASKDEL ; ask if deletion is appropriate 26 R !!,"Do you wish to delete this report? NO// ",X:DTIME 27 S:'$T!(X="")!(X["^") X="N" 28 I "Nn"[$E(X) D UNLOCK^RAUTL12("^RARPT(",RAIEN) G DEL 29 I "Yy"'[$E(X) D G ASKDEL 30 . W:X'["?" $C(7) 31 . W !!?3,"Enter 'YES' to delete this report, or 'NO' not to." 32 . Q 33 ; comment out next line, these 3 vars are already set by CHK17^RARTE3 34 ;S RADFN=+$P(RA0,"^",2),RADTI=9999999.9999-$P(RA0,"^",3),RACN=$P(RA0,"^",4) 35 G:RAOK=2 AD2 ;don't remove piece 17 if rpt doesn't match exm's rpt ptr 36 ; del other member's REPORT TEXT xrefs, and set pointer to #74 as null 37 D DEL17^RARTE2(RAIEN) ;del ptrs to file 74 excluding lead case of prtset 38 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) 39 G:'$D(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,0))#2 AD2 40 ; kill any xrefs for file #70's REPORT TEXT 41 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI D ENKILL^RAXREF(70.03,17,RAIEN,.DA) 42 ; set REPORT TEXT to null 43 S $P(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,0),"^",17)="" 44 AD2 K RAXIT S RAPRG74=1 ;RAPRG74 used in kill logic file 74 fld .01 45 D MARKDEL^RARTE7 ; mark report deleted, save DXs, remov DXs fm case(s) 46 W !?10,"...report deletion complete." 47 D:RAOK'=2 UP1^RAUTL1 ;skip update status if report doesn't belong to exm 48 D UPDTPNT^RAUTL9(RAIEN) ; Update pointers in 74.2, and 74.4! 49 D UNLOCK^RAUTL12("^RARPT(",RAIEN) ; unlock report 50 I RAOK'=2,$T(DELETE^WVRALINK)]"" D DELETE^WVRALINK(RADFN,RADTI,RACNI) ; women's health, skip if report doesn't belong to exm 51 END K %,%Y,D0,DA,DIC,DIE,RAJ1,DIK,RADFN,RADTI,RACN,RACNI,RA0,RAIEN,RAOR 52 K RADUZ,RAORDIFN,RAPRG74,RASN,RASTI,Y 53 K RADATE,RADTE,X 54 K RA791,RACANC,RACN0,RACPT,RACPTNDE,RAI,RAN,RAOBR4,RAPKG,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RASULT,RAXIT 55 K C,D,D1,DDER,DDH,DFN,DI,DISYS,DIWF,DIWL,DIWR,DQ,DR,GMRAL,HLN,HLRESLT,HLSAN,I,VA,VADM,VAERR,X0 56 Q 57 ; 58 UNVER(RAXRPT) ; unverify a report 59 ; Input: if RAXRPT>0 then we know the report we wish to delete 60 ; this requires no user interaction. 61 ; RAXRPT=0 user is prompted for the report they wish to 62 ; delete (interactive) 63 ; 64 I 'RAXRPT D SET^RAPSET1 G Q:$D(XQUIT) 65 I RAXRPT N X S X=RAXRPT 66 S RAXIT=0,DIC="^RARPT(",DIC("S")="I $P(^(0),U,5)=""V""" 67 S DIC(0)=$S('RAXRPT:"AEMQZ",1:"NZ") 68 D DICW,^DIC K DIC I Y<0 D Q Q 69 S RA74B4=$G(Y(0)) 70 S (RARPT,DA)=+Y,RADFN=$P(Y(0),U,2) 71 S RADTI=9999999.9999-$P(Y(0),"^",3),RACN=$P(Y(0),"^",4) 72 I 'RAXRPT S DR="D EN1^RAUTL9 I $D(DIRUT) S Y=""@99"";S:RASTATX'=""PD"" Y=""@10"";25;@10;5////^S X=RASTATX;S:X=""V"" Y=""@99"";9///@;17///@;100///NOW;@99" 73 S:RAXRPT DR="5////^S X=""D"";9///@;17///@;100///NOW" 74 ;11/07/2005 KAM/BAY 110020 Modified next line to look for voice recognition 75 S DIE="^RARPT(",DR(2,74.01)="2////U;3////"_$S(($D(RAQUIET)#2)&($D(RASUB)#2):$G(^TMP("RARPT-REC",$J,RASUB,"RAVERF")),1:DUZ) 76 S RAXIT=$$LOCK^RAUTL12("^RARPT(",RARPT) 77 I RAXIT D Q QUIT 78 D ^DIE K DE,DQ,DIE,DR D UNLOCK^RAUTL12("^RARPT(",RARPT) 79 N RA1,RA2,RA3,RA4 S RA1=RADFN,RA2=RADTI,RA3=RACN,RA4=RARPT 80 S RA(0)=$G(^RARPT(RARPT,0)),RA(5)=$P(^RARPT(RARPT,0),"^",5) 81 S RA(7)=$P(^RARPT(RARPT,0),"^",7),RA(10)=$P(^RARPT(RARPT,0),"^",10) 82 I RA(5)'="V" D 83 . I RA(7)]"" D ENKILL^RAXREF(74,7,RA(7),RARPT) S $P(^RARPT(RARPT,0),"^",7)="" 84 . I RA(10)]"" D ENKILL^RAXREF(74,10,RA(10),RARPT) S $P(^RARPT(RARPT,0),"^",10)="" 85 . N RADDEN,RAUTOE S (RADDEN,RAUTOE)="" D ^RARTR,EN1^RARTE3(RA4) 86 . Q 87 S RADFN=RA1,RADTI=RA2,RACN=RA3,RARPT=RA4 88 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) I $D(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,0)) D UP1^RAUTL1 I $D(^RABTCH(74.4,"B",RARPT)) D 89 .S DA=0 F S DA=$O(^RABTCH(74.4,"B",RARPT,DA)) Q:'DA D 90 ..S DIK="^RABTCH(74.4," D ^DIK 91 ..Q 92 .Q 93 I "^V^EF^"'[("^"_$P($G(^RARPT(RARPT,0)),"^",5)_"^"),$T(DELETE^WVRALINK)]"" D DELETE^WVRALINK(RADFN,RADTI,RACNI) ; women's health 94 ; 95 Q ; Kill and quit 96 K DFN,DI,DIW,DIWF,DIWI,DIWL,DIWT,DIWTC,DIWX,RAACNT,RANUM,RAST,RAWHOVER 97 K %,%DT,%W,%Y,%Y1,C,D,D0,D1,DA,DIC,DIE,DIK,DR,RA,RACN,RACNI,RADATE 98 K RADFN,RADIV,RADTE,RADTI,RAJ,RAOR,RAORDIFN,RARPT,RASET,RASN,RASTATX 99 K RASTI,RAXIT,X,XQUIT,Y,RA74B4,DDH,DIPGM,DISYS,I,RADUZ 100 Q 101 ; 102 STD S (RALR,RALI)=1 103 STD1 S DIC="^RA(74.1,",DIC("A")="Select 'Standard' Report to Copy: ",DIC(0)="AEMQ" D ^DIC K DIC("A") Q:Y<0 104 ASKSEL W:$$IMPRPT(RARPT) !!,"Report already exists. This will over-write it." 105 W !,"Are you sure you want the '",$P(Y,"^",2),"' standard report? No// " R X:DTIME G STD1:'$T!(X="")!(X["^")!("Nn"[$E(X)) 106 I "Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to select the '",$P(Y,"^",2),"' standard report, or 'NO' not to." G ASKSEL 107 I RALR=1,RALI=1 K ^RARPT(RARPT,"R"),^("I") 108 F I=1:1 Q:'$D(^RA(74.1,+Y,"R",I,0)) S ^RARPT(RARPT,"R",RALR,0)=^(0),RALR=RALR+1 109 F I=1:1 Q:'$D(^RA(74.1,+Y,"I",I,0)) S ^RARPT(RARPT,"I",RALI,0)=^(0),RALI=RALI+1 110 ASKADD R !!,"Do you want to add another standard to this report? No// ",X:DTIME Q:'$T!(X="")!(X["^")!("Nn"[$E(X)) I "Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to add another standard to this report, or 'NO' not to." G ASKADD 111 S (^RARPT(RARPT,"R",RALR,0),^RARPT(RARPT,"I",RALI,0))="",RALR=RALR+1,RALI=RALI+1 W ! G STD1 112 ; 113 EDTRPT ; Called from 'RARTE4' and 'RARTVER'. 114 S RACT=$S('+$G(^RARPT(RARPT,"T")):"I",1:"E") 115 S:'$D(^RARPT(RARPT,"T")) ^("T")="" 116 S DA=RARPT,DR="[RA REPORT EDIT]",DIE="^RARPT(" D ^DIE K DE,DQ ;,RAFLAGK 117 I $D(Y),RACT="V",'$P(^RARPT(RARPT,0),"^",9) W !,$C(7),"You must enter a verifying Interpreting Physician to 'VERIFY' a report.",!?3,"...report status will now be changed to 'DRAFT'." S DA=RARPT,DR="5///D" D ^DIE K DE,DQ ;Q 118 Q:$D(RAONLINE)&($G(RARDX)="E") 119 ; move PACS line to its own subroutine 120 ;I $D(RAFLAGK) K RAFLAGK Q 121 G:$D(Y) PACS 122 ;Since report editing is not necessarily screened by sign-on imaging 123 ;type, use the imaging type on the exam record ;ch 124 S RAIMGTYI=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2),RAIMGTYJ=$P($G(^RA(79.2,+RAIMGTYI,0)),U) 125 S X=+$O(^RA(72,"AA",RAIMGTYJ,9,0)),DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," K RAIMGTYI,RAIMGTYJ 126 S DR=13_$S(RACT'="V":"",'$D(^RA(72,X,.1)):"",$P(^(.1),"^",5)'="Y":"",1:"R")_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1" 127 S RAXIT=$$LOCK^RAUTL12(DIE,.DA) 128 I RACT="V",$P($G(^RA(72,X,.1)),"^",5)="Y" S DIE("NO^")="BACK" 129 I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR 130 I RAXIT!($P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)="")!($D(Y)) K RAXIT G PACS 131 S DR="50///"_RACN 132 S DR(2,70.03)=13.1 133 S DR(3,70.14)=.01_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1" 134 S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT""," 135 S RAXIT=$$LOCK^RAUTL12("^RADPT("_RADFN_",""DT"","_RADTI_",""P"",",.RACNI) ;lock at P level 136 I 'RAXIT D ^DIE D UNLOCK^RAUTL12("^RADPT("_RADFN_",""DT"","_RADTI_",""P"",",.RACNI) K DA,DE,DQ,DIE,DR ;unlock at P level 137 K RAXIT 138 PACS I ($P(^RARPT(RARPT,0),U,5)="V")!($P(^(0),U,5)="R") D RPT^RAHLRPC 139 I "^V^EF"[("^"_$P(^RARPT(RARPT,0),U,5)_"^"),$T(CREATE^WVRALINK)]"" D CREATE^WVRALINK(RADFN,RADTI,RACNI) ; women's health 140 Q 141 ; 142 ASKBTCH R !!,"Do you want to batch print reports? Yes// ",X:DTIME S:'$T X="^" S:X="" X="Y" Q:X["^" I "Nn"'[$E(X),"Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to batch print reports, or 'NO' not to." G ASKBTCH 143 Q 144 ; 145 ASKPRT R !!,"Do you want to print batch now? No// ",X:DTIME S:'$T!(X="")!(X["^") X="N" I "Nn"'[$E(X),"Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to print this batch, or 'NO' not to." G ASKPRT 146 Q 147 DICW ; Build DIC("W") string 148 N DO D DO^DIC1 149 S DIC("W")=$S($G(DIC("W"))]"":DIC("W")_" ",1:"")_"W "" "",$$FLD^RARTFLDS(+Y,""PROC"")" 150 Q 151 IMPRPT(Y) ; Does the report we are currently editing have either Report 152 ; or Impression Text? 153 ; Input : 'Y' - the ien of the report being edited 154 ; Output: '1' - either impression or report text exists, '0' - neither 155 ; report or impression text exists. 156 Q $S(+$O(^RARPT(Y,"I",0)):1,+$O(^RARPT(Y,"R",0)):1,1:0) 1 RARTE1 ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Edit/Delete a Report ;6/10/98 16:08 2 ;;5.0;Radiology/Nuclear Medicine;**2,15,17,23,31,68**;Mar 16, 1998 3 ;11/07/2005 KAM/BAY 110020 - Correct DUZ ID from Talk Technology 4 ; During the Unverify process 5 DEL D SET^RAPSET1 I $D(XQUIT) K XQUIT Q 6 S (RAPRG74,RAXIT)=0 7 S DIC("A")="Select Report Day-Case#: " 8 S DIC("W")="S RA0=^(0) W "" "",$S($D(^DPT(+$P(RA0,""^"",2),0)):$P(^(0),""^""),1:""Unknown"") K RA0 W "" "",$$FLD^RARTFLDS(+Y,""PROC"")" 9 S DIC="^RARPT(",DIC(0)="AEMQZ" D ^DIC K DIC G END:Y<0 10 S RA0=Y(0),(DA,RAIEN)=+Y 11 I $O(^RARPT(RAIEN,2005,0)) D D END Q 12 . W !!?5,"Cannot delete a report that is associated with an image." 13 . W !?5,"Contact your Imaging Coordinator for further assistance.",! 14 . S DIR(0)="E",DIR("A")="Press RETURN to continue" 15 . D ^DIR K DIR,DIRUT,DUOUT 16 . Q ;08/23/00 17 D CHK17^RARTE3 18 G:RAOK=1 END ;can't del rpt w/o RACN or RACNI so avoid err at UP1^RAUTL1 19 S RAXIT=$$LOCK^RAUTL12("^RARPT(",RAIEN) 20 I RAXIT K RAXIT D END Q ; record locked by another 21 ASKDEL ; ask if deletion is appropriate 22 R !!,"Do you wish to delete this report? NO// ",X:DTIME 23 S:'$T!(X="")!(X["^") X="N" 24 I "Nn"[$E(X) D UNLOCK^RAUTL12("^RARPT(",RAIEN) G DEL 25 I "Yy"'[$E(X) D G ASKDEL 26 . W:X'["?" $C(7) 27 . W !!?3,"Enter 'YES' to delete this report, or 'NO' not to." 28 . Q 29 ; comment out next line, these 3 vars are already set by CHK17^RARTE3 30 ;S RADFN=+$P(RA0,"^",2),RADTI=9999999.9999-$P(RA0,"^",3),RACN=$P(RA0,"^",4) 31 G:RAOK=2 AD2 ;don't remove piece 17 if rpt doesn't match exm's rpt ptr 32 ; del other member's REPORT TEXT xrefs, and set pointer to #74 as null 33 D DEL17^RARTE2(RAIEN) 34 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) 35 G:'$D(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,0))#2 AD2 36 ; kill any xrefs for file #70's REPORT TEXT 37 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI D ENKILL^RAXREF(70.03,17,RAIEN,.DA) 38 ; set REPORT TEXT to null 39 S $P(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,0),"^",17)="" 40 AD2 K RAXIT S DIK="^RARPT(",RAPRG74=1 41 S DA=RAIEN D ^DIK 42 W !?10,"...report deletion complete." 43 D:RAOK'=2 UP1^RAUTL1 ;skip update status if report doesn't belong to exm 44 D UPDTPNT^RAUTL9(RAIEN) ; Update pointers in 74.2, and 74.4! 45 D UNLOCK^RAUTL12("^RARPT(",RAIEN) ; unlock report 46 I RAOK'=2,$T(DELETE^WVRALINK)]"" D DELETE^WVRALINK(RADFN,RADTI,RACNI) ; women's health, skip if report doesn't belong to exm 47 END K %,%Y,D0,DA,DIC,DIE,RAJ1,DIK,RADFN,RADTI,RACN,RACNI,RA0,RAIEN,RAOR 48 K RADUZ,RAORDIFN,RAPRG74,RASN,RASTI,Y 49 K RADATE,RADTE,X 50 K RA791,RACANC,RACN0,RACPT,RACPTNDE,RAI,RAN,RAOBR4,RAPKG,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RASULT,RAXIT 51 K C,D,D1,DDER,DDH,DFN,DI,DISYS,DIWF,DIWL,DIWR,DQ,DR,GMRAL,HLN,HLRESLT,HLSAN,I,VA,VADM,VAERR,X0 52 Q 53 ; 54 UNVER(RAXRPT) ; unverify a report 55 ; Input: if RAXRPT>0 then we know the report we wish to delete 56 ; this requires no user interaction. 57 ; RAXRPT=0 user is prompted for the report they wish to 58 ; delete (interactive) 59 ; 60 I 'RAXRPT D SET^RAPSET1 G Q:$D(XQUIT) 61 I RAXRPT N X S X=RAXRPT 62 S RAXIT=0,DIC="^RARPT(",DIC("S")="I $P(^(0),U,5)=""V""" 63 S DIC(0)=$S('RAXRPT:"AEMQZ",1:"NZ") 64 D DICW,^DIC K DIC I Y<0 D Q Q 65 S RA74B4=$G(Y(0)) 66 S (RARPT,DA)=+Y,RADFN=$P(Y(0),U,2) 67 S RADTI=9999999.9999-$P(Y(0),"^",3),RACN=$P(Y(0),"^",4) 68 I 'RAXRPT S DR="D EN1^RAUTL9 I $D(DIRUT) S Y=""@99"";S:RASTATX'=""PD"" Y=""@10"";25;@10;5////^S X=RASTATX;S:X=""V"" Y=""@99"";9///@;17///@;100///NOW;@99" 69 S:RAXRPT DR="5////^S X=""D"";9///@;17///@;100///NOW" 70 ;11/07/2005 KAM/BAY 110020 Modified next line to look for voice recognition 71 S DIE="^RARPT(",DR(2,74.01)="2////U;3////"_$S(($D(RAQUIET)#2)&($D(RASUB)#2):$G(^TMP("RARPT-REC",$J,RASUB,"RAVERF")),1:DUZ) 72 S RAXIT=$$LOCK^RAUTL12("^RARPT(",RARPT) 73 I RAXIT D Q QUIT 74 D ^DIE K DE,DQ,DIE,DR D UNLOCK^RAUTL12("^RARPT(",RARPT) 75 N RA1,RA2,RA3,RA4 S RA1=RADFN,RA2=RADTI,RA3=RACN,RA4=RARPT 76 S RA(0)=$G(^RARPT(RARPT,0)),RA(5)=$P(^RARPT(RARPT,0),"^",5) 77 S RA(7)=$P(^RARPT(RARPT,0),"^",7),RA(10)=$P(^RARPT(RARPT,0),"^",10) 78 I RA(5)'="V" D 79 . I RA(7)]"" D ENKILL^RAXREF(74,7,RA(7),RARPT) S $P(^RARPT(RARPT,0),"^",7)="" 80 . I RA(10)]"" D ENKILL^RAXREF(74,10,RA(10),RARPT) S $P(^RARPT(RARPT,0),"^",10)="" 81 . N RADDEN,RAUTOE S (RADDEN,RAUTOE)="" D ^RARTR,EN1^RARTE3(RA4) 82 . Q 83 S RADFN=RA1,RADTI=RA2,RACN=RA3,RARPT=RA4 84 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) I $D(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,0)) D UP1^RAUTL1 I $D(^RABTCH(74.4,"B",RARPT)) D 85 .S DA=0 F S DA=$O(^RABTCH(74.4,"B",RARPT,DA)) Q:'DA D 86 ..S DIK="^RABTCH(74.4," D ^DIK 87 ..Q 88 .Q 89 I $P($G(^RARPT(RARPT,0)),"^",5)'="V",$T(DELETE^WVRALINK)]"" D DELETE^WVRALINK(RADFN,RADTI,RACNI) ; women's health 90 ; 91 Q ; Kill and quit 92 K DFN,DI,DIW,DIWF,DIWI,DIWL,DIWT,DIWTC,DIWX,RAACNT,RANUM,RAST,RAWHOVER 93 K %,%DT,%W,%Y,%Y1,C,D,D0,D1,DA,DIC,DIE,DIK,DR,RA,RACN,RACNI,RADATE 94 K RADFN,RADIV,RADTE,RADTI,RAJ,RAOR,RAORDIFN,RARPT,RASET,RASN,RASTATX 95 K RASTI,RAXIT,X,XQUIT,Y,RA74B4,DDH,DIPGM,DISYS,I,RADUZ 96 Q 97 ; 98 STD S (RALR,RALI)=1 99 STD1 S DIC="^RA(74.1,",DIC("A")="Select 'Standard' Report to Copy: ",DIC(0)="AEMQ" D ^DIC K DIC("A") Q:Y<0 100 ASKSEL W:$$IMPRPT(RARPT) !!,"Report already exists. This will over-write it." 101 W !,"Are you sure you want the '",$P(Y,"^",2),"' standard report? No// " R X:DTIME G STD1:'$T!(X="")!(X["^")!("Nn"[$E(X)) 102 I "Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to select the '",$P(Y,"^",2),"' standard report, or 'NO' not to." G ASKSEL 103 I RALR=1,RALI=1 K ^RARPT(RARPT,"R"),^("I") 104 F I=1:1 Q:'$D(^RA(74.1,+Y,"R",I,0)) S ^RARPT(RARPT,"R",RALR,0)=^(0),RALR=RALR+1 105 F I=1:1 Q:'$D(^RA(74.1,+Y,"I",I,0)) S ^RARPT(RARPT,"I",RALI,0)=^(0),RALI=RALI+1 106 ASKADD R !!,"Do you want to add another standard to this report? No// ",X:DTIME Q:'$T!(X="")!(X["^")!("Nn"[$E(X)) I "Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to add another standard to this report, or 'NO' not to." G ASKADD 107 S (^RARPT(RARPT,"R",RALR,0),^RARPT(RARPT,"I",RALI,0))="",RALR=RALR+1,RALI=RALI+1 W ! G STD1 108 ; 109 EDTRPT ; Called from 'RARTE4' and 'RARTVER'. 110 S RACT=$S('+$G(^RARPT(RARPT,"T")):"I",1:"E") 111 S:'$D(^RARPT(RARPT,"T")) ^("T")="" 112 S DA=RARPT,DR="[RA REPORT EDIT]",DIE="^RARPT(" D ^DIE K DE,DQ ;,RAFLAGK 113 I $D(Y),RACT="V",'$P(^RARPT(RARPT,0),"^",9) W !,$C(7),"You must enter a verifying Interpreting Physician to 'VERIFY' a report.",!?3,"...report status will now be changed to 'DRAFT'." S DA=RARPT,DR="5///D" D ^DIE K DE,DQ ;Q 114 Q:$D(RAONLINE)&($G(RARDX)="E") 115 ; move PACS line to its own subroutine 116 ;I $D(RAFLAGK) K RAFLAGK Q 117 G:$D(Y) PACS 118 ;Since report editing is not necessarily screened by sign-on imaging 119 ;type, use the imaging type on the exam record ;ch 120 S RAIMGTYI=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2),RAIMGTYJ=$P($G(^RA(79.2,+RAIMGTYI,0)),U) 121 S X=+$O(^RA(72,"AA",RAIMGTYJ,9,0)),DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," K RAIMGTYI,RAIMGTYJ 122 S DR=13_$S(RACT'="V":"",'$D(^RA(72,X,.1)):"",$P(^(.1),"^",5)'="Y":"",1:"R")_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1" 123 S RAXIT=$$LOCK^RAUTL12(DIE,.DA) 124 I RACT="V",$P($G(^RA(72,X,.1)),"^",5)="Y" S DIE("NO^")="BACK" 125 I 'RAXIT D ^DIE D UNLOCK^RAUTL12(DIE,.DA) K DA,DE,DQ,DIE,DR 126 I RAXIT!($P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)="")!($D(Y)) K RAXIT G PACS 127 S DR="50///"_RACN 128 S DR(2,70.03)=13.1 129 S DR(3,70.14)=.01_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1" 130 S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT""," 131 S RAXIT=$$LOCK^RAUTL12("^RADPT("_RADFN_",""DT"","_RADTI_",""P"",",.RACNI) ;lock at P level 132 I 'RAXIT D ^DIE D UNLOCK^RAUTL12("^RADPT("_RADFN_",""DT"","_RADTI_",""P"",",.RACNI) K DA,DE,DQ,DIE,DR ;unlock at P level 133 K RAXIT 134 PACS I ($P(^RARPT(RARPT,0),U,5)="V")!($P(^(0),U,5)="R") D RPT^RAHLRPC 135 I $P(^RARPT(RARPT,0),U,5)="V",$T(CREATE^WVRALINK)]"" D CREATE^WVRALINK(RADFN,RADTI,RACNI) ; women's health 136 Q 137 ; 138 ASKBTCH R !!,"Do you want to batch print reports? Yes// ",X:DTIME S:'$T X="^" S:X="" X="Y" Q:X["^" I "Nn"'[$E(X),"Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to batch print reports, or 'NO' not to." G ASKBTCH 139 Q 140 ; 141 ASKPRT R !!,"Do you want to print batch now? No// ",X:DTIME S:'$T!(X="")!(X["^") X="N" I "Nn"'[$E(X),"Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to print this batch, or 'NO' not to." G ASKPRT 142 Q 143 DICW ; Build DIC("W") string 144 N DO D DO^DIC1 145 S DIC("W")=$S($G(DIC("W"))]"":DIC("W")_" ",1:"")_"W "" "",$$FLD^RARTFLDS(+Y,""PROC"")" 146 Q 147 IMPRPT(Y) ; Does the report we are currently editing have either Report 148 ; or Impression Text? 149 ; Input : 'Y' - the ien of the report being edited 150 ; Output: '1' - either impression or report text exists, '0' - neither 151 ; report or impression text exists. 152 Q $S(+$O(^RARPT(Y,"I",0)):1,+$O(^RARPT(Y,"R",0)):1,1:0)
Note:
See TracChangeset
for help on using the changeset viewer.
