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