source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPXRM.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1RAPXRM ;HOIFO/SWM - API for Clinical Reminders ;10/1/03 09:33
2 ;;5.0;Radiology/Nuclear Medicine;*33**;Mar 16, 1998
3 ; IA #3731 documents entry point EN1
4 ; IA #4113 grants use of rtn PXRMSXRM
5 ; IA #4114 grants use of direct Set and Kill, use of ^PXRMINDX(70
6EN1(RADAS,RARM) ;retrieve data from Clin. Rem.'s new style index "ACR"
7 ; Input:
8 ; RADAS = last subscript of (required), for example:
9 ; ^PXRMINDX(70,"IP",43,1,2,2920720.1049,"2;DT;7079279.895;P;3;0")
10 ; ^PXRMINDX(70,"PI",9,3,45,2921204.155,"9;DT;7078795.8449;P;1;0")
11 ; RARM = array name passed by reference (required)
12 ; Output:
13 ; RARM("aaa") = external value, eg.:
14 ; RARM("EXAM D/T") = Exam Date and time in yyymmdd.hhmm format
15 ; RARM("EXAM STATUS") = Exam Status name
16 ; RARM("PROCEDURE") = Procedure name
17 ; RARM("INTERPRETING PHYSICIAN") = Primary Staff; else Primary Resident
18 ; If exam node doesn't exist, then RARM is undefined
19 ;
20 K RARM ; clear output var
21 ; validate RADAS string
22 Q:$P(RADAS,";",2)'="DT" Q:$P(RADAS,";",4)'="P" Q:$P(RADAS,";",6)'="0"
23 N RA0,RADFN,RADTI,RACNI,X,I,J
24 S RADFN=$P(RADAS,";"),RADTI=$P(RADAS,";",3),RACNI=$P(RADAS,";",5)
25 S RA0=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
26 Q:RA0=""
27 S RARM("EXAM D/T")=9999999.9999-RADTI
28 S RARM("EXAM STATUS")=$P($G(^RA(72,+$P(RA0,U,3),0)),U)
29 S RARM("PROCEDURE")=$P($G(^RAMIS(71,+$P(RA0,U,2),0)),U)
30 S X=$S($P(RA0,U,15):+$P(RA0,U,15),$P(RA0,U,12):+$P(RA0,U,12),1:"")
31 S:X'="" X=$$GET1^DIQ(200,X,.01)
32 S RARM("INTERPRETING PHYSICIAN")=X
33 ;
34 ; RARM("PDX")=Primary DX text
35 ; this node won't exist if there's no data for Prim DX
36 ; RARM("SDX",n)=Secondary DX text at ^RADPT(-,"DT",-,"P",-,"DX",n,0)
37 ; the n may have gaps if a Secondary DX was deleted
38 ;
39 S:$P(RA0,U,13)'="" RARM("PDX")=$P($G(^RA(78.3,+$P(RA0,U,13),0)),U)
40 S I=0
41 F S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",I)) Q:'I I $D(^(I,0)) S J=+$G(^(0)) I J S RARM("SDX",I)=$P($G(^RA(78.3,J,0)),U)
42 Q
43 ;===============================================================
44 ; RAD section copied from former location RAD^PXRMSXRO
45RAD ;Build the index for RAD/NUC MED PATIENT.
46 N D0,D1,D2,DA,DAS,DFN,END,ENTRIES,GLOBAL,IND,NE,NERROR,PROC
47 N START,TEMP,TENP,TEXT
48 ;Don't leave any old stuff around.
49 K ^PXRMINDX(70)
50 S GLOBAL=$$GET1^DID(70,"","","GLOBAL NAME")
51 S ENTRIES=$P(^RADPT(0),U,4)
52 S TENP=ENTRIES/10
53 S TENP=+$P(TENP,".",1)
54 I TENP<1 S TENP=1
55 D BMES^XPDUTL("Building index for RAD DATA")
56 S TEXT="There are "_ENTRIES_" entries to process."
57 D MES^XPDUTL(TEXT)
58 S START=$H
59 S (D0,IND,NE,NERROR)=0
60 F S D0=+$O(^RADPT(D0)) Q:D0=0 D
61 . S IND=IND+1
62 . I IND#TENP=0 D
63 .. S TEXT="Processing entry "_IND
64 .. D MES^XPDUTL(TEXT)
65 . I IND#10000=0 W "."
66 . S DFN=$P($G(^RADPT(D0,0)),U,1)
67 . I DFN="" D Q
68 .. S ETEXT=D0_" no patient"
69 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q
70 . S D1=0
71 . F S D1=+$O(^RADPT(D0,"DT",D1)) Q:D1=0 D
72 .. S DATE=$P($G(^RADPT(D0,"DT",D1,0)),U,1)
73 .. S DA=D0_";DT;"_D1
74 .. I DATE="" D Q
75 ... S ETEXT=DA_" no date"
76 ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q
77 .. S D2=0
78 .. F S D2=+$O(^RADPT(D0,"DT",D1,"P",D2)) Q:D2=0 D
79 ... S TEMP=$G(^RADPT(D0,"DT",D1,"P",D2,0))
80 ... S DAS=DA_";P;"_D2_";0"
81 ... S PROC=$P(TEMP,U,2)
82 ... I PROC="" D Q
83 .... S ETEXT=DAS_" no procedure"
84 .... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q
85 ... S ^PXRMINDX(70,"IP",PROC,DFN,DATE,DAS)=""
86 ... S ^PXRMINDX(70,"PI",DFN,PROC,DATE,DAS)=""
87 ... S NE=NE+1
88 S END=$H
89 S TEXT=NE_" RAD/NUC MED PATIENT results indexed."
90 D MES^XPDUTL(TEXT)
91 D DETIME^PXRMSXRM(START,END)
92 ;If there were errors send a message.
93 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
94 ;Send a MailMan message with the results.
95 D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
96 S ^PXRMINDX(70,"GLOBAL NAME")=$$GET1^DID(70,"","","GLOBAL NAME")
97 S ^PXRMINDX(70,"BUILT BY")=DUZ
98 S ^PXRMINDX(70,"DATE BUILT")=$$NOW^XLFDT
99 Q
100 ;
101 ;===============================================================
102KRAD(X,DA) ;Delete index for RAD/NUC MED PATIENT file.
103 N DAS,DATE
104 S DATE=9999999.9999-DA(1)
105 S DAS=DA(2)_";DT;"_DA(1)_";P;"_DA_";0"
106 K ^PXRMINDX(70,"IP",X(1),DA(2),DATE,DAS)
107 K ^PXRMINDX(70,"PI",DA(2),X(1),DATE,DAS)
108 Q
109 ;
110 ;===============================================================
111SRAD(X,DA) ;Set index for RAD/NUC MED PATIENT file.
112 ;DA(2)=DFN, DA(1)=EXAM DATE (inverse date), DA=Examinations Entry
113 ;X(1)=PROCEDURE
114 N DAS,DATE
115 S DATE=9999999.9999-DA(1)
116 S DAS=DA(2)_";DT;"_DA(1)_";P;"_DA_";0"
117 S ^PXRMINDX(70,"IP",X(1),DA(2),DATE,DAS)=""
118 S ^PXRMINDX(70,"PI",DA(2),X(1),DATE,DAS)=""
119 Q
120 ;
Note: See TracBrowser for help on using the repository browser.