source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL15.m@ 1076

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1RAUTL15 ;HISC/GJC-Skeleton rpt del if no data entered. ;11/5/99 12:33
2 ;;5.0;Radiology/Nuclear Medicine;**5,10**;Mar 16, 1998
3EN3(IEN74) ;Delete the skeleton report and pointer from Rad Pt file to
4 ; report if user has not entered any report data (i.e. user ^'d out
5 ; of report entry/edit after the system created a skeleton record).
6 ; If the report is deleted, a bulletin will not be generated!
7 N RA,RAPRG74,RATXT
8 S RA(0)=$G(^RARPT(IEN74,0)) Q:RA(0)']"" 0
9 I $O(^RARPT(IEN74,2005,0))>0 Q 0
10 S RA("I")=$S(+$O(^RARPT(IEN74,"I",0))'>0:1,1:0)
11 S RA("P")=$S($G(^RARPT(IEN74,"P"))="":1,1:0)
12 S RA("R")=$S(+$O(^RARPT(IEN74,"R",0))'>0:1,1:0)
13 S RA(5)=$P(RA(0),"^",5),RA(5)=$S(RA(5)]"":RA(5),1:"Null")
14 I $L(RA(0),"^")'>6,("dD"[RA(5)),(RA("I")),(RA("P")),(RA("R")) D Q 1
15 . N %,D,D0,DA,DIC,DIE,DIK,DQ,DR,X,Y
16 . ; +++++ Delete Report Text pointer from the Examinations +++++
17 . ; +++++ multiple in the Rad/Nuc Med Patient file +++++
18 . ; +++++ if the data is xrefed, delete xref +++++
19 . ; del other print member's REPORT TEXT xrefs, & set ptr to #74 as null
20 . D DEL17^RARTE2(IEN74)
21 . ; set RADFN, RADTI & RACNI if not defined! This situation will arise
22 . ; when this code finds an incomplete Rad/Nuc Med Report while running
23 . ; the post-init portion of the software.
24 . S:'$D(RADFN) RADFN=$P(RA(0),"^",2)
25 . S:'$D(RADTI) RADTI=9999999.9999-$P(RA(0),"^",3)
26 . S:'$D(RACNI) RACNI=+$O(^RADPT(RADFN,"DT",RADTI,"P","B",+$P(RA(0),"^",4),0))
27 . S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
28 . D ENKILL^RAXREF(70.03,17,IEN74,.DA)
29 . ; Delete pointers to the Rad/Nuc Med Report file i.e, '^RARPT('
30 . ;*******
31 . S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)="" K DA,X
32 . ; +++++ Delete Report pntr from the Reports multiple in +++++
33 . ; +++++ the Reports Batches file +++++
34 . ; +++++ Delete Report pntr from the Report Distribution file +++++
35 . D UPDTPNT^RAUTL9(IEN74)
36 . ; +++++ Delete the entry from the Rad/Nuc Med Reports file +++++
37 . S DA=IEN74,DIK="^RARPT(" D ^DIK
38 . S RATXT(1)=" "
39 . S RATXT(2)=" Report not complete. Must Delete......deletion complete!"
40 . S RATXT(3)=$C(7) D MES^XPDUTL(.RATXT)
41 . Q
42 Q 0
43KMV ; kill miscellaneous variables
44 K %DT,%I,%RET,%T
45 K D,D0,D1,D2,D3,DA,DDER,DDH,DI,DIE,DIFLD,DIG,DIH,DISYS,DIU,DIW,DIWF,DIWL,DIWR,DIWT,DG,DK,DL,DM,DN,DR
46 K POP
47 Q
48 ;
49CZECH(Y) ; check if an order can be cancelled, held, or scheduled.
50 ; Y -> ien of the Rad/Nuc Med Orders file.
51 ; Y1 -> if OE/RR > 2.5 & no order number: 1, else 0
52 ; Called from: VALORD subroutine
53 N RAORDER,Y1 S Y1=0
54 S RAORDER(0)=$G(^RAO(75.1,+Y,0)) Q:RAORDER(0)']""
55 I '$P(RAORDER(0),U,7),(+$$ORVR^RAORDU()>2.5) D
56 . N Y2 ; 'Y2' is the procedure name
57 . S Y1=1,Y2=$P($G(^RAMIS(71,+$P(RAORDER(0),U,2),0)),U)
58 . D INV(RAOPTN,Y2)
59 . Q
60 Q Y1
61INV(X,X1) ; invalid action message called from the schedule/cancel or hold
62 ; request options.
63 ; X -> point of orgin (option) X1 -> procedure name
64 ; Called from: CZECH subroutine
65 S X=$$UP^XLFSTR($E(X,1,3)),X1=$S(X1]"":X1,1:"Unknown")
66 W !!?3,"Sorry, can't "_$S(X="SCH":"schedule",X="CAN":"cancel",1:"hold")
67 W " this request until OE/RR assigns an order number"
68 W !?3,"for procedure: ",X1,!?3,"Please try later!"
69 Q
70VALORD ; validate order data, i.e, has OE/RR order # and the site is running
71 ; a version of OE/RR > 2.5 Called from: 2^RAORD, 3^RAORD & 4^RAORD
72 N G1,G2,RA751 S G1=0
73 F S G1=$O(RAORDS(G1)) Q:G1'>0 D
74 . S G2=$$CZECH(+$G(RAORDS(G1))) K:G2 RAORDS(G1)
75 . Q
76 Q
77DPROC(RADFN,RADTI,RACNI,RAOIFN) ; Determine if the ordered procedure is
78 ; different from the registered procedure.
79 ; Input Variables: RADFN-Patient DFN
80 ; RADTI-inverse DT of exam (if exists)
81 ; RACNI-IEN on the case node (if exists)
82 ; RAOIFN-IEN of the order
83 ; Output: null-procedures don't differ -OR- no order/exam
84 ; not null-ordered proc_"^"_registered proc data
85 ; registered procedure data includes imaging type, procedure
86 ; type and CPT codes (if any)
87 ;
88 ; NOTE: The only time we don't set ^TMP($J,"RA DIFF PRC") is when
89 ; we are using the 'Detailed Request Display' option and the ordered
90 ; procedure is the same as the registered procedure. All other
91 ; Request display options output the ordered procedure, the
92 ; registered procedure and exam case number if the order
93 ; is active.
94 ;
95 N RA7003,RA751
96 S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
97 S RA751=$G(^RAO(75.1,RAOIFN,0))
98 Q:$P(RA7003,"^",2)=""!($P(RA751,"^",2)="") "" ; missing order or xam
99 I '$D(RAOPT("ORDERPRINTS")),'$D(RAOPT("ORDERPRINTPAT")) Q:$P(RA7003,"^",2)=$P(RA751,"^",2) "" ; except for 2 print options, quit if req.prc=regis.prc
100 N RA71,RACPT,RACSE,RAITY,RAPRC,RATY,X,Y
101 S RACSE=$$RJ^XLFSTR($P(RA7003,"^"),5)
102 S RA71=$G(^RAMIS(71,$P(RA7003,"^",2),0))
103 S RACPT=$P($$NAMCODE^RACPTMSC(+$P(RA71,"^",9),DT),"^")
104 S RAPRC=$E($$GET1^DIQ(71,+$P(RA7003,"^",2)_",",.01),1,36)
105 S RAITY=$$GET1^DIQ(79.2,+$P(RA71,"^",12)_",",3)
106 S RATY=$$GET1^DIQ(71,$P(RA7003,"^",2)_",",6)
107 S RATY=$E(RATY,1)_$$LOW^XLFSTR($E(RATY,2,9999))
108 S X="",Y=RACSE_" "_RAPRC,Y(0)="("_RAITY_" "_RATY_" "_RACPT_")"
109 S Y(0)=Y(0)_" "_$E($P($G(^RA(72,+$P(RA7003,"^",3),0)),"^"),1,4)
110 S $E(X,1,42)=Y,$E(X,44,70)=Y(0)
111 Q X
Note: See TracBrowser for help on using the repository browser.