| [613] | 1 | RAREG ;HISC/GJC AISC/MJK,RMO-Register Rad/NM Patient ;8/15/97 11:04
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**23,85**;Mar 16, 1998;Build 4
|
|---|
| 3 | ; 06/07/2007 KAM/BAY RA*5*85 Remedy Call 185568 Exam Backdating
|
|---|
| 4 | K RADTE
|
|---|
| 5 | PAT D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
|
|---|
| 6 | ; Is our sign-on location inactive?
|
|---|
| 7 | K DIR,DIROUT,DIRUT,DTOUT,DUOUT,RADIRYN,RAINATVE
|
|---|
| 8 | S RAINATVE=$$INLO^RAUTL13(+RAMLC)
|
|---|
| 9 | I RAINATVE D I $D(XQUIT)!(RADIRYN) K RADIRYN,RAINATVE Q
|
|---|
| 10 | . W !!?3,"Your current Imaging Location: '"_$P($G(RACCESS(DUZ,"LOC",+RAMLC)),U,2)_"' is inactive."
|
|---|
| 11 | . W !?3,"If you wish to register this patient for an exam, locations must be switched.",!
|
|---|
| 12 | . S DIR(0)="YA",DIR("B")="Yes"
|
|---|
| 13 | . S DIR("A")="Do you wish to switch locations at this time? "
|
|---|
| 14 | . S DIR("?")="Enter 'Y'es to switch locations, 'N'o to exit."
|
|---|
| 15 | . D ^DIR K DIR,DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 16 | . S RADIRYN=$S('+Y:1,1:0) K X,Y Q:RADIRYN
|
|---|
| 17 | . W ! D KILL^RAPSET1,^RAPSET
|
|---|
| 18 | . I $D(XQUIT) K RACCESS Q
|
|---|
| 19 | . Q
|
|---|
| 20 | K RADIRYN,RAINATVE
|
|---|
| 21 | D HOME^%ZIS K X S DIC(0)="AEMQZ"_$S('$D(RAVSTFLG):"L",1:"") D ^RADPA G Q:Y<0 S RADFN=+Y,RACAT=$S($P(Y(0),"^",4)']"":"OUTPATIENT",1:$P($P(^DD(70,.04,0),$P(Y(0),"^",4)_":",2),";")) S:'$D(RAVSTFLG) RAREGFLG=""
|
|---|
| 22 | D ^RADEM2 G Q:RAPOP I $D(RAVSTFLG) S J=$O(^RADPT(RADFN,"DT",0)) G ADD1:$D(^(+J,0)) W !?3,*7,"A previous exam date does not exist for this patient!",! G Q
|
|---|
| 23 | DT K RADTEBAD N RAHRS S RAHRS=+$P($G(^RA(79,+RAMDIV,.1)),"^",24) ;How many hrs in adv?
|
|---|
| 24 | R !!,"Imaging Exam Date/Time: NOW// ",X:DTIME
|
|---|
| 25 | G Q:'$T!(X=" ")!(X="^")
|
|---|
| 26 | S:X="" RANOW="",X="NOW"
|
|---|
| 27 | S %DT(0)=-$$FMADD^XLFDT($$NOW^XLFDT,0,RAHRS,0,0),%DT="ETXR"
|
|---|
| 28 | D ^%DT K %DT G DT:Y<0
|
|---|
| 29 | ;
|
|---|
| 30 | ; 06/06/2007 KAM/BAY Remedy Call 185568 Added next line
|
|---|
| 31 | I '$$BACKDATE(Y) G DT
|
|---|
| 32 | ;
|
|---|
| 33 | DT1 S RADTE=Y,RADTI=9999999.9999-RADTE
|
|---|
| 34 | I '$D(RAVSTFLG),$D(^RADPT(RADFN,"DT",RADTI,0)) D G DT
|
|---|
| 35 | . W !,*7,"Patient already has exams (which may have been cancelled) for this date/time."
|
|---|
| 36 | . W !,"....use 'Add Exams to Last Visit' option, or enter a date/time a few minutes",!," earlier or later."
|
|---|
| 37 | . Q
|
|---|
| 38 | ;Next line checks for case where exam date entered is a 'subset' of an
|
|---|
| 39 | ;existing exam date (i.e. 10:00 is a subset of 11:00 because DIC lookup
|
|---|
| 40 | ;drops trailing zeros - this was causing users to hang ;CH 4/19/94
|
|---|
| 41 | S RADTEBAD=$O(^RADPT(RADFN,"DT","B",RADTE)) I RADTEBAD[RADTE W *7,!,"?? Please try a different time of day (a few minutes later)." G DT
|
|---|
| 42 | ;next line is a lock to prevent multiple users from adding/overwriting
|
|---|
| 43 | ;the same "DT" node if they begin registration of a case for the same
|
|---|
| 44 | ;patient during the same minute using NOW as the exam date/time.
|
|---|
| 45 | L +^RADPT(RADFN,"DT",RADTI):1 I '$T W !,*7,"Someone else is now editing an exam for this patient on the date/time",!,"you selected. Please try entering a date/time a few minutes earlier or later." G DT
|
|---|
| 46 | K RADTEBAD I $D(RANOW),$D(RAWARD) S RACAT="INPATIENT"
|
|---|
| 47 | I '$D(RANOW) K RAWARD,RABED,RASER D ^RASERV S:$D(RAWARD) RACAT="INPATIENT"
|
|---|
| 48 | G ^RAREG1
|
|---|
| 49 | ;
|
|---|
| 50 | ADD S RAVSTFLG="" G PAT
|
|---|
| 51 | ADD1 S YY=^RADPT(RADFN,"DT",J,0)
|
|---|
| 52 | I $P(YY,"^",4)'=+RAMLC D G Q
|
|---|
| 53 | . W !!?3,"Last visit date is for location '",$S('$D(^RA(79.1,+$P(YY,"^",4),0)):"Unknown",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"Unknown"),"'."
|
|---|
| 54 | . W !?3,"Your current location is defined as: '"
|
|---|
| 55 | . W $P($G(^SC(+$P($G(^RA(79.1,+RAMLC,0)),"^"),0)),"^")_"'."
|
|---|
| 56 | . W !?3,"You must log into the '"
|
|---|
| 57 | . W $S('$D(^RA(79.1,+$P(YY,"^",4),0)):"Unknown",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"Unknown"),"' location"
|
|---|
| 58 | . W !?3,"to add exams to the last visit.",$C(7)
|
|---|
| 59 | . K DIR S DIR(0)="E" D ^DIR K DIR Q
|
|---|
| 60 | S X1=DT,X2=-1 D C^%DTC I X>+YY,'$D(^XUSEC("RA MGR",DUZ)) W !!?3,*7,"Last visit was before yesterday. No adding exams allowed!" G Q
|
|---|
| 61 | W !!,"Last Visit Date/Time: " S Y=$P(YY,"^") D D^RAUTL W Y,!!?1,"Case No.",?10,"Procedure",?42,"Status",!?1,"--------",?10,"---------",?42,"------"
|
|---|
| 62 | N RA0,RA17,RA1 S RA1=0 ;1=valid rpt, 0=stub/no rpt
|
|---|
| 63 | F I=0:0 S I=$O(^RADPT(RADFN,"DT",J,"P",I)) Q:I'>0 I $D(^(I,0)) S Y=^(0) D ADD2
|
|---|
| 64 | I $P(YY,U,5),RA1 S Y=1 D Q
|
|---|
| 65 | . I $Y>(IOSL-6) N DIR S DIR(0)="E" D ^DIR Q:Y'>0
|
|---|
| 66 | . W !!?2,"NOTE: Because all the cases within this exam date/time are"
|
|---|
| 67 | . W !?8,"part of one order set, and a valid report has been filed"
|
|---|
| 68 | . W !?8,"already, additional procedures may not be added to this visit."
|
|---|
| 69 | . W !?8,"You must register the desired exam(s) at a later date/time."
|
|---|
| 70 | . N Y R !!?2,"Press RETURN to continue:",Y:DTIME
|
|---|
| 71 | . Q
|
|---|
| 72 | S RARD("A")="Do you wish to add exams to this visit? ",RARD(1)="Yes^add exams to this visit",RARD(2)="No^stop",RARD("B")=2,RARD(0)="S" D SET^RARD K RARD G Q:$E(X)'="Y"
|
|---|
| 73 | S RAREC="",Y=$P(YY,"^") G DT1
|
|---|
| 74 | ADD2 W !?3,$P(Y,"^"),?10,$E($S($D(^RAMIS(71,+$P(Y,"^",2),0)):$P(^(0),"^"),1:"Unknown"),1,30),?42,$S($D(^RA(72,+$P(Y,"^",3),0)):$P(^(0),"^"),1:"Unknown")
|
|---|
| 75 | K RAVLEDTI,RAVLECNI,RASHA,RARSH,RAPIFN,RARDTE,RALIFN S RAVLEDTI=J,RAVLECNI=I,RADIV=$P(YY,"^",3),RACAT=$S('$D(RAWARD):$P($P(^DD(75.1,4,0),$P(Y,"^",4)_":",2),";"),1:RACAT)
|
|---|
| 76 | S:"CS"[$E(RACAT)&($D(^DIC(34,+$P(Y,"^",9),0))) RASHA=$P(^(0),"^") S:"R"[$E(RACAT)&($D(^RADPT(RADFN,"DT",J,"P",I,"R"))) RARSH=^("R")
|
|---|
| 77 | S:$D(^VA(200,+$P(Y,"^",14),0)) RAPIFN=+$P(Y,"^",14) S:$P(Y,"^",21) RARDTE=$P(Y,"^",21) S:$D(^SC(+$P(Y,"^",22),0)) RALIFN=+$P(Y,"^",22)
|
|---|
| 78 | I $P(Y,"^",17)]"" D ; is this a non-stub report
|
|---|
| 79 | . S RA17=+$P(Y,"^",17) ;keep RA17 only if image stub rpt exists
|
|---|
| 80 | . I '$D(^RARPT(RA17,0))#2 K RA17 Q ; no rpt
|
|---|
| 81 | . Q:$$STUB^RAEDCN1(RA17) ;quit if image stub rpt
|
|---|
| 82 | . S RA1=1 K RA17 ; valid (non-stub record)
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | Q K %,%DT,DA,DIC,GMRAL,POP,RABED,RACAT,RADFN,RADIV,RADTE,RADTI,RALIFN,RANME,RAOIFN,RAPIFN,RAPOP,RAPTFL,RARDTE,RAREGFLG,RARSH,RASER,RASEX,RASHA,RAVLECNI,RAVLEDTI,RAVSTFLG,RAWARD,X,XQUIT,Y,YY
|
|---|
| 86 | K %W,%X,%Y,%Y1,D,D3,DDER,DDH,DFN,DI,DIG,DIH,DIU,DIW,DIWF,DIWI,DIWL,DIWR
|
|---|
| 87 | K DIWT,DIWTC,DIWX,DN,I,RACANC,RACN0,RACPT,RACPTNDE,RAEXIT,RAHSMULT,RAI
|
|---|
| 88 | K RAN,RAOBR4,RAPARENT,RAPRCNDE,RAPROC,RAPROCI,RAPROCIT,RAPRV,RASKIPIT
|
|---|
| 89 | K VA,VADM,VAERR,Z
|
|---|
| 90 | Q
|
|---|
| 91 | ;06/06/2007 KAM/BAY for Remedy Call 185568 Added next 11 lines
|
|---|
| 92 | BACKDATE(RADT) ;
|
|---|
| 93 | N RACON,RAEXMDAT,RATODAY,RAANS,Y
|
|---|
| 94 | S RACON=1
|
|---|
| 95 | S X="NOW" D ^%DT S RATODAY=Y K %DT
|
|---|
| 96 | I (RATODAY-RADT)>9999 D
|
|---|
| 97 | . W !!,"********************************************************"
|
|---|
| 98 | . W !,"The Exam date entered is more than one year in the past."
|
|---|
| 99 | . W !,"********************************************************"
|
|---|
| 100 | . R !!,"Are you sure you want to continue Y/N?: N// ",RAANS:DTIME
|
|---|
| 101 | . I "Y,y,YES,yes,Yes"'[RAANS!(RAANS="") S RACON=0
|
|---|
| 102 | Q RACON
|
|---|
