- 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/RARTE4.m
r613 r623 1 RARTE4 ;HISC/GJC - Edit/Delete Reports (cont) ;11/4/97 08:02 2 ;;5.0;Radiology/Nuclear Medicine;**15,27,41,82,56**;Mar 16, 1998;Build 3 3 ;Supported IA #10060 ^VA(200 4 ;Supported IA #10007 DO^DIC1 5 LOCK ;Try to lock next avail IEN, if locked - fail, if used - increment again 6 S I=I+1 S RAXIT=$$LOCK^RAUTL12("^RARPT(",I) I RAXIT D UNLOCK2 D INCRPT G START^RARTE 7 I $D(^RARPT(I))!($D(^RARPT("B",I))) D UNLOCK^RAUTL12("^RARPT(",I) G LOCK 8 S ^RARPT(I,0)=RARPTN,RARPT=I,^(0)=$P(^RARPT(0),"^",1,2)_"^"_I_"^"_($P(^(0),"^",4)+1),^DISV($S($D(DUZ)#2:DUZ,1:0),"^RARPT(")=I S:'$D(^RARPT(RARPT,"T")) ^("T")="" 9 S ^RARPT(RARPT,0)=RARPTN_"^"_RADFN_"^"_RADTE_"^"_RACN_"^D",DIK="^RARPT(",DA=RARPT D IX1^DIK 10 K %,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y 11 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI 12 S DIE="^RADPT("_RADFN_",""DT"","_RADTI_",""P""," 13 S DR="17////"_RARPT D ^DIE 14 K %,D,D0,DA,DI,DIC,DIE,DQ,DR,RAY1,X,Y 15 I RAPRTSET D PTR^RARTE2 16 I RAXIT D UNLOCK2,UNLOCK^RAUTL12("^RARPT(",RARPT) Q 17 G IN0 18 IN ;lock rpt for the 1st time if editing existing rpt 19 S RAXIT=$$LOCK^RAUTL12("^RARPT(",RARPT) I RAXIT D UNLOCK2,Q Q 20 IN0 ;skip to here if rpt created in this session and already locked 21 G IN1:'$P(RAMDV,"^",14) K RACOPY 22 S DIC("S")="I RARPT'=+Y,$P(^(0),U,5)'=""X""" ;omit same & deleted rpt 23 ; Remedy ticket #245679, remove multi-index lookup 24 S DIC("A")="Select Report to Copy: ",DIC(0)="AEQ",DIC="^RARPT(" 25 D DICW,^DIC K DIC("S"),DIC("A") S RAY1=Y 26 I X="^" D UNLOCK^RAUTL12("^RARPT(",RARPT),UNLOCK2 S RAXIT=$$EN3^RAUTL15(RARPT) D INCRPT G START^RARTE 27 G IN1:RAY1<0 28 F J="H","R","I" K ^RARPT(RARPT,J) 29 F J="R","I" F I=1:1 Q:'$D(^RARPT(+Y,J,I,0)) S ^RARPT(RARPT,J,I,0)=^(0) 30 ;F I=1:1 Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",1,"H",I,0)) S ^RARPT(RARPT,"H",I,0)=^RADPT(RADFN,"DT",RADTI,"P",1,"H",I,0) 31 S RACOPY="" 32 IN1 ;skip to here if div param disallows rpt copying 33 I $P(RAMDV,"^",14) W !,RAI 34 K RAFIN 35 S DR="50///"_RACN 36 S DR(2,70.03)="12//^S X=$S($D(RARES)&($D(RABTCH)):RARES,1:"""");S:$D(^VA(200,+X,0)) RARES=$P(^(0),U);I X'>0 S Y=""@15"";70;@15;15" 37 I $P(RAMDV,"^",28) S DR(2,70.03)=DR(2,70.03)_"R" ; req'd for DIVISION 38 S DR(2,70.03)=DR(2,70.03)_"//^S X=$S($D(RASTFF)&($D(RABTCH)):RASTFF,1:"""");S:$D(^VA(200,+X,0)) RASTFF=$P(^(0),U);I X'>0 S Y=""@1"";60;@1;S RAFIN=""""" 39 S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT""," D ^DIE K DE,DQ 40 D ELOC^RABWRTE ; Billing Aware -- ask Inter. Img Loc 41 I RAPRTSET S RADRS=2 D COPY^RARTE2 ; copy resid and staff 42 G PRT:'$D(RAFIN) W !,RAI 43 ; 44 ; **BNT - Commented out to stop copying history from file 70 to 74 45 ; in patch RA*5*27. The history is now referenced directly from file 70. 46 ; I $D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H")),'$D(^RARPT(RARPT,"H")) F I=1:1 Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",I,0)) S ^RARPT(RARPT,"H",I,0)=^(0) 47 ; ** 48 I '$D(RACOPY),$P(RAMDV,"^",12) D STD^RARTE1 I X="^" G PRT 49 W !,RAI D EDTRPT^RARTE1 50 PRT D UNLOCK^RAUTL12(RAPNODE,RACNI) 51 ; --- copy diags to other cases of print set 52 I RAPRTSET S RADRS=1,RAXIT=0 D COPY^RARTE2 L -^RADPT(RADFN,"DT",RADTI) ;unlock dt level only after copying is done 53 ; wait til report has been checked for completeness before unlocking it 54 S RAXIT=$$EN3^RAUTL15(RARPT) D UNLOCK^RAUTL12("^RARPT(",RARPT) 55 I RAXIT S RAXIT=0 D UNLOCK2 D INCRPT G START^RARTE 56 ; --- 57 D K RAAB G PRT1:'$D(RABTCH),PRT1:'$D(^RABTCH(74.2,+RABTCH,0)) 58 .; RAHLTCPB flag is inactive 59 .N RAHLTCPB S RAHLTCPB=1 D:$S('$D(RACT):0,RACT="V":1,1:0) UPSTAT^RAUTL0 60 .D:$S('$D(RACT):1,RACT'="V":1,1:0) UP1^RAUTL1 61 ASKREP W !!,"Do you want to place this report in the batch ",RABTCHN,"? Yes// " R X:DTIME S:'$T!(X["^") X="N" S:X="" X="Y" G PRT1:"Nn"[$E(X) 62 I "Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to place this report in the batch, or 'NO' not to." G ASKREP 63 I $D(^RABTCH(74.2,"D",RARPT,RABTCH)) W !?5,"...report is already part of the '",RABTCHN,"' batch" D INCRPT G START^RARTE 64 W !?5,"...will now place report in the '",RABTCHN,"' batch" S DIE="^RABTCH(74.2,",DA=RABTCH,DR="25///"_$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN,DR(2,74.21)="2////N" D ^DIE K DQ,DE D INCRPT G START^RARTE 65 PRT1 R !!,"Do you wish to print this report? No// ",X:DTIME S:'$T!(X["^") X="N" S:X="" X="N" ;030497 66 I "Nn"[$E(X) D INCRPT G START^RARTE 67 I "Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to print this report, or 'NO' not to." G PRT1 68 S ION=$P(RAMLC,"^",10),IOP=$S(ION]"":"Q;"_ION,1:"Q") 69 S RAMES="W !!?3,""Report has been queued for printing on device "",ION,"".""" 70 D Q^RARTR D INCRPT G START^RARTE 71 ; 72 Q I $D(RABTCH),$D(^RABTCH(74.2,+RABTCH,"R",0)) D ASKPRT^RARTE1,BTCH^RABTCH:"Yy"[$E(X) 73 Q1 K %,%DT,%W,%Y,%Y1,C,D0,D1,DA,DIC,DIE,DR,OREND,RABTCH,RABTCHN,RACN,RACNI,RACOPY,RACS,RACT,RADATE,RADFN,RADTE,RADTI,RADUZ,RAELESIG,RAFIN,RAHEAD,RAI,RAJ1 74 K RALI,RALR,RANME,RANUM,RAOR,RAORDIFN,RAPNODE,RAPRC,RAPRIT,RAQUIT,RAREPORT,RARES,RARPDT,RARPT,RARPTN,RARPTZ,RARTPN,RASET,RASI,RASIG,RASN,RASSN,RAST,RAST1,RASTI,RASTFF,RAVW,XQUIT,W,X,Y 75 K D,D2,DDER,DI,DIPGM,DLAYGO,J,RAEND,RAF5,RAFL,RAFST,RAIX,RAPOP,RAY1 76 K ^TMP($J,"RAEX") 77 K POP,DUOUT 78 Q 79 DICW ; Build DIC("W") string 80 N DO D DO^DIC1 81 S DIC("W")=$S($G(DIC("W"))]"":DIC("W")_" ",1:"")_"W "" "",$$FLD^RARTFLDS(+Y,""PROC"")" 82 Q 83 INCRPT ; Kill extraneous variables to avoid collisions. 84 ; Incomplete report information, select another case #. 85 K %,%DT,D,D0,D1,D2,DI,DIC,DIWT,DN,I,J,RACN,RACNI,RACT,RADATE,RADTE 86 K RADTI,RAFIN,RAI,RALI,RALR,RANME,RAPRC,RARPT,RARPTN,RASSN,RAST,RAVW,X 87 Q 88 UNLOCK2 D UNLOCK^RAUTL12(RAPNODE,RACNI) L -^RADPT(RADFN,"DT",RADTI) 89 Q 1 RARTE4 ;HISC/GJC - Edit/Delete Reports (cont) ;11/4/97 08:02 2 ;;5.0;Radiology/Nuclear Medicine;**15,27,41,82**;Mar 16, 1998;Build 8 3 LOCK ;Try to lock next avail IEN, if locked - fail, if used - increment again 4 S I=I+1 S RAXIT=$$LOCK^RAUTL12("^RARPT(",I) I RAXIT D UNLOCK2 D INCRPT G START^RARTE 5 I $D(^RARPT(I))!($D(^RARPT("B",I))) D UNLOCK^RAUTL12("^RARPT(",I) G LOCK 6 S ^RARPT(I,0)=RARPTN,RARPT=I,^(0)=$P(^RARPT(0),"^",1,2)_"^"_I_"^"_($P(^(0),"^",4)+1),^DISV($S($D(DUZ)#2:DUZ,1:0),"^RARPT(")=I S:'$D(^RARPT(RARPT,"T")) ^("T")="" 7 S ^RARPT(RARPT,0)=RARPTN_"^"_RADFN_"^"_RADTE_"^"_RACN_"^D",DIK="^RARPT(",DA=RARPT D IX1^DIK 8 K %,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y 9 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI 10 S DIE="^RADPT("_RADFN_",""DT"","_RADTI_",""P""," 11 S DR="17////"_RARPT D ^DIE 12 K %,D,D0,DA,DI,DIC,DIE,DQ,DR,RAY1,X,Y 13 I RAPRTSET D PTR^RARTE2 14 I RAXIT D UNLOCK2,UNLOCK^RAUTL12("^RARPT(",RARPT) Q 15 G IN0 16 IN ;lock rpt for the 1st time if editing existing rpt 17 S RAXIT=$$LOCK^RAUTL12("^RARPT(",RARPT) I RAXIT D UNLOCK2,Q Q 18 IN0 ;skip to here if rpt created in this session and already locked 19 G IN1:'$P(RAMDV,"^",14) K RACOPY S DIC("S")="I RARPT'=+Y",DIC("A")="Select Report to Copy: ",DIC(0)="AMEQ",DIC="^RARPT(" D DICW,^DIC K DIC("S"),DIC("A") S RAY1=Y 20 I X="^" D UNLOCK^RAUTL12("^RARPT(",RARPT),UNLOCK2 S RAXIT=$$EN3^RAUTL15(RARPT) D INCRPT G START^RARTE 21 G IN1:RAY1<0 22 F J="H","R","I" K ^RARPT(RARPT,J) 23 F J="R","I" F I=1:1 Q:'$D(^RARPT(+Y,J,I,0)) S ^RARPT(RARPT,J,I,0)=^(0) 24 ;F I=1:1 Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",1,"H",I,0)) S ^RARPT(RARPT,"H",I,0)=^RADPT(RADFN,"DT",RADTI,"P",1,"H",I,0) 25 S RACOPY="" 26 IN1 ;skip to here if div param disallows rpt copying 27 I $P(RAMDV,"^",14) W !,RAI 28 K RAFIN 29 S DR="50///"_RACN 30 S DR(2,70.03)="12//^S X=$S($D(RARES)&($D(RABTCH)):RARES,1:"""");S:$D(^VA(200,+X,0)) RARES=$P(^(0),U);I X'>0 S Y=""@15"";70;@15;15" 31 I $P(RAMDV,"^",28) S DR(2,70.03)=DR(2,70.03)_"R" ; req'd for DIVISION 32 S DR(2,70.03)=DR(2,70.03)_"//^S X=$S($D(RASTFF)&($D(RABTCH)):RASTFF,1:"""");S:$D(^VA(200,+X,0)) RASTFF=$P(^(0),U);I X'>0 S Y=""@1"";60;@1;S RAFIN=""""" 33 S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT""," D ^DIE K DE,DQ 34 D ELOC^RABWRTE ; Billing Aware -- ask Inter. Img Loc 35 I RAPRTSET S RADRS=2 D COPY^RARTE2 ; copy resid and staff 36 G PRT:'$D(RAFIN) W !,RAI 37 ; 38 ; **BNT - Commented out to stop copying history from file 70 to 74 39 ; in patch RA*5*27. The history is now referenced directly from file 70. 40 ; I $D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H")),'$D(^RARPT(RARPT,"H")) F I=1:1 Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",I,0)) S ^RARPT(RARPT,"H",I,0)=^(0) 41 ; ** 42 I '$D(RACOPY),$P(RAMDV,"^",12) D STD^RARTE1 I X="^" G PRT 43 W !,RAI D EDTRPT^RARTE1 44 PRT D UNLOCK^RAUTL12(RAPNODE,RACNI) 45 ; --- copy diags to other cases of print set 46 I RAPRTSET S RADRS=1,RAXIT=0 D COPY^RARTE2 L -^RADPT(RADFN,"DT",RADTI) ;unlock dt level only after copying is done 47 ; wait til report has been checked for completeness before unlocking it 48 S RAXIT=$$EN3^RAUTL15(RARPT) D UNLOCK^RAUTL12("^RARPT(",RARPT) 49 I RAXIT S RAXIT=0 D UNLOCK2 D INCRPT G START^RARTE 50 ; --- 51 D K RAAB G PRT1:'$D(RABTCH),PRT1:'$D(^RABTCH(74.2,+RABTCH,0)) 52 .; RAHLTCPB flag is inactive 53 .N RAHLTCPB S RAHLTCPB=1 D:$S('$D(RACT):0,RACT="V":1,1:0) UPSTAT^RAUTL0 54 .D:$S('$D(RACT):1,RACT'="V":1,1:0) UP1^RAUTL1 55 ASKREP W !!,"Do you want to place this report in the batch ",RABTCHN,"? Yes// " R X:DTIME S:'$T!(X["^") X="N" S:X="" X="Y" G PRT1:"Nn"[$E(X) 56 I "Yy"'[$E(X) W:X'["?" *7 W !!?3,"Enter 'YES' to place this report in the batch, or 'NO' not to." G ASKREP 57 I $D(^RABTCH(74.2,"D",RARPT,RABTCH)) W !?5,"...report is already part of the '",RABTCHN,"' batch" D INCRPT G START^RARTE 58 W !?5,"...will now place report in the '",RABTCHN,"' batch" S DIE="^RABTCH(74.2,",DA=RABTCH,DR="25///"_$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN,DR(2,74.21)="2////N" D ^DIE K DQ,DE D INCRPT G START^RARTE 59 PRT1 R !!,"Do you wish to print this report? No// ",X:DTIME S:'$T!(X["^") X="N" S:X="" X="N" ;030497 60 I "Nn"[$E(X) D INCRPT G START^RARTE 61 I "Yy"'[$E(X) W:X'["?" *7 W !!?3,"Enter 'YES' to print this report, or 'NO' not to." G PRT1 62 S ION=$P(RAMLC,"^",10),IOP=$S(ION]"":"Q;"_ION,1:"Q") 63 S RAMES="W !!?3,""Report has been queued for printing on device "",ION,"".""" 64 D Q^RARTR D INCRPT G START^RARTE 65 ; 66 Q I $D(RABTCH),$D(^RABTCH(74.2,+RABTCH,"R",0)) D ASKPRT^RARTE1,BTCH^RABTCH:"Yy"[$E(X) 67 Q1 K %,%DT,%W,%Y,%Y1,C,D0,D1,DA,DIC,DIE,DR,OREND,RABTCH,RABTCHN,RACN,RACNI,RACOPY,RACS,RACT,RADATE,RADFN,RADTE,RADTI,RADUZ,RAELESIG,RAFIN,RAHEAD,RAI,RAJ1 68 K RALI,RALR,RANME,RANUM,RAOR,RAORDIFN,RAPNODE,RAPRC,RAPRIT,RAQUIT,RAREPORT,RARES,RARPDT,RARPT,RARPTN,RARPTZ,RARTPN,RASET,RASI,RASIG,RASN,RASSN,RAST,RAST1,RASTI,RASTFF,RAVW,XQUIT,W,X,Y 69 K D,D2,DDER,DI,DIPGM,DLAYGO,J,RAEND,RAF5,RAFL,RAFST,RAIX,RAPOP,RAY1 70 K ^TMP($J,"RAEX") 71 K POP,DUOUT 72 Q 73 DICW ; Build DIC("W") string 74 N DO D DO^DIC1 75 S DIC("W")=$S($G(DIC("W"))]"":DIC("W")_" ",1:"")_"W "" "",$$FLD^RARTFLDS(+Y,""PROC"")" 76 Q 77 INCRPT ; Kill extraneous variables to avoid collisions. 78 ; Incomplete report information, select another case #. 79 K %,%DT,D,D0,D1,D2,DI,DIC,DIWT,DN,I,J,RACN,RACNI,RACT,RADATE,RADTE 80 K RADTI,RAFIN,RAI,RALI,RALR,RANME,RAPRC,RARPT,RARPTN,RASSN,RAST,RAVW,X 81 Q 82 UNLOCK2 D UNLOCK^RAUTL12(RAPNODE,RACNI) L -^RADPT(RADFN,"DT",RADTI) 83 Q
Note:
See TracChangeset
for help on using the changeset viewer.