source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAESO.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1RAESO ;HISC/CAH,GJC AISC/SAW-Override Exam Status to Complete ;4/28/97 08:00
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;Mass override exam status to complete
4 D SET^RAPSET1 I $D(XQUIT) K XQUIT,POP Q
5 N RAXIT,RASAVDR S RAXIT=0 D CZECH Q:RAXIT
6 W !,"Your sign-on imaging type is ",RAIMGTY,", so only exams",!,"of imaging type ",RAIMGTY," will be changed to complete.",!
7 K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to proceed" D ^DIR I Y'=1 G EXIT
8 K DIR,X,Y
9ASK K DIC S DIC(0)="AEQM",DIC="^RA(72,"
10 S DIC("S")="I $P(^(0),U,3)'=9,($P(^(0),U,3)'=0),($P(^(0),U,7)=+$O(^RA(79.2,""B"",RAIMGTY,0)))"
11 D ^DIC G EXIT:$D(DUOUT)!($D(DTOUT)) I Y'<0 S RASTIEN(+Y)="" G ASK
12 G EXIT:'$D(RASTIEN) K DIC W !!,"Enter a cutoff date that is at least sixty days prior to today."
13 S X1=DT,X2=-60 D C^%DTC S DIR(0)="D^:"_X D ^DIR G EXIT:$D(DIRUT) S RAECDTI=9999999-Y D DD^%DT S RAECDTE=Y
14 ;Following line commented out for v 4.5 - setting the 10th piece to 0 was preventing update of subfld 75, Exam Status Times. These are now updated.
15 W ! S IOP="Q",ZTRTN="DQ^RAESO"
16 S ZTSAVE("RAI*")="",ZTSAVE("RAM*")="",ZTSAVE("RAE*")=""
17 S ZTSAVE("RASTIEN(")=""
18 S ZTDESC="Rad/Nuc Med Mass Override of Exam Status to Complete",RAMES="W !,?5,""Output Queued.""",RAZIS=1 D ZIS^RAUTL K IOP
19 G EXIT
20DQ U IO S PG=0 S RAIMGTYI=$O(^RA(79.2,"B",RAIMGTY,0))
21 F RAST=0:0 S RAST=$O(RASTIEN(RAST)) Q:RAST'>0 F RADFN=0:0 S RADFN=$O(^RADPT("AS",RAST,RADFN)) Q:RADFN'>0 F RADTI=RAECDTI:0 S RADTI=$O(^RADPT("AS",RAST,RADFN,RADTI)) Q:RADTI'>0 D L1
22 I '$D(RAF4) D HD W !!,"There were no exams with the statuses selected in the time frame specified that",!,"needed to be overridden to complete."
23EXIT D CLOSE^RAUTL
24 K DA,DIC,DIE,DIR,DIRUT,DIROUT,DUOUT,DTOUT,DR,PG,POP
25 K RA,RACN,RACNI,RADFN,RADTE,RADTI,RAECDTE,RAECDTI,RAF1,RAF4,RAIMGTYI,RAMES,RAPOP,RAST,RASTIEN,RAZMDV,RAZIS
26 K X,X1,X2,XQUIT,Y,ZTDESC,ZTRTN,ZTSAVE,I,POP,DISYS,C Q
27L1 F RACNI=0:0 S RACNI=$O(^RADPT("AS",RAST,RADFN,RADTI,RACNI)) Q:RACNI'>0 I $P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2)=RAIMGTYI I $D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S RA(0)=^(0) D SET
28 Q
29SET S RACN=$P(RA(0),"^"),RADTE=9999999.9999-RADTI,DA=RADFN,DIE="^RADPT(",DR="[RA OVERRIDE]",RASAVDR=DR D ^DIE K DE,DQ,DIE,DR
30 D:'$D(RAF1) HD D:$Y-(IOSL-11)>0 HD W !,$E($P(^DPT(RADFN,0),"^"),1,25),?28 S Y=RADTE D DD^%DT W Y,?49,RACN,?57,$S($D(^RA(72,RAST,0)):$E($P(^(0),"^"),1,20),1:"Unknown") S RAF4=1
31 D ^RAORDC Q
32HD S PG=PG+1 W:$Y>0 @IOF,!!,?(IOM\2-26),"Report on Mass Override of Exam Statuses to Complete",?(IOM-8),"PAGE ",PG
33 W !,?(IOM\2-22),"Cutoff Date for this Report is: ",RAECDTE,!,?(IOM\2-17),"Date Report was Run: " S Y=DT D DD^%DT W Y
34 W !!!,"Patient Name",?28,"Exam Date",?49,"Case #",?57,"Status Before Override",! S RAF1=1 Q
35SINGLE ;Override Single Exam Status to 'COMPLETE'
36 D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
37 N RAXIT,RASAVDR S RAXIT=0 D CZECH Q:RAXIT
38 S RAVW="" D ^RACNLU G EXIT1:"^"[X W ! S I="",$P(I,"-",80)="" W I
39 W !?1,"Name : ",$E(RANME,1,25),?40,"Pt ID : ",RASSN,!?1,"Case No. : ",RACN,?40,"Procedure : ",$E(RAPRC,1,25)
40 W !?1,"Exam Date: ",RADATE,?40,"Technologist: " I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0))>0,$D(^VA(200,+^($O(^(0)),0),0)) W $E($P(^(0),"^"),1,25)
41 W !?40,"Req Phys : ",$E($S($D(^VA(200,+$P(Y(0),"^",14),0)):$P(^(0),"^"),1:""),1,25),! S I="",$P(I,"-",80)="" W I
42 I $P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2)'=$O(^RA(79.2,"B",RAIMGTY,0)) W !,"Sorry, your sign-on imaging type, ",RAIMGTY,!,"doesn't match the imaging type of this exam.",! G SINGLE
43 I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !!?3,*7,"...exam 'cancelled' therefore override is not allowed." G SINGLE
44 I $D(^RA(72,"AA",RAIMGTY,9,+RAST)) W !!?3,*7,"...exam is already 'complete'." G SINGLE
45ASKOVR R !!,"Are you sure? No// ",X:DTIME S:'$T!(X="")!(X["^") X="N" G SINGLE:"Nn"[$E(X) I "Yy"'[$E(X) W:X'["?" *7 W !!?3,"Enter 'YES' to override exam status to 'COMPLETE', or 'NO' not to." G ASKOVR
46 W !?3,"...will now attempt override..." S DA=RADFN,DIE="^RADPT(",DR="[RA OVERRIDE]",RASAVDR=DR D ^DIE K DE,DQ,DIE,DR I '$D(Y) W !?6,"...exam status is now '",$P(^RA(72,$O(^RA(72,"AA",RAIMGTY,9,0)),0),"^"),"'.",! D ^RAORDC K DR
47 G SINGLE
48EXIT1 K %,%DT,%I,%X,%Y,D,D0,D1,D2,D3,DA,DI,DIC,J,POP,RADFN,RADIV,RADTI,RACNI
49 K RANME,RASSN,RADATE,RADTE,RACN,RAHEAD,RAI,RAPRC,RAPIFN,RARPT,RAST,RAVW
50 K W,X,XQUIT,Y,^TMP($J,"RAEX")
51 Q
52CZECH ; Check for a 'Complete' exam status for a particular imaging type
53 I '+$O(^RA(72,"AA",RAIMGTY,9,0)) D
54 . S RAXIT=1
55 . W !?5,"An Examination Status of 'Complete' must be defined for an"
56 . W !?5,"Imaging Type of: "_RAIMGTY_". Please contact your"
57 . W !?5,"Radiology/Nuclear Medicine ADPAC for further assistance.",$C(7)
58 . Q
59 Q
Note: See TracBrowser for help on using the repository browser.