Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAPXRM

RAPXRM.m

Go to the documentation of this file.
  1. RAPXRM ;HOIFO/SWM,GJC - API for Clinical Reminders ;04 Mar 2019 12:02 PM
  1. ;;5.0;Radiology/Nuclear Medicine;**33,56,153,156**;Mar 16, 1998;Build 1
  1. ; IA #3731 documents entry point EN1
  1. ; IA #4113 grants use of rtn PXRMSXRM
  1. ; IA #4114 grants use of direct Set and Kill, use of ^PXRMINDX(70
  1. ;Supported IA #2056 GET1^DIQ
  1. ;Supported IA #2052 GET1^DID
  1. ;Supported IA #10141 BMES^XPDUTL, MES^XPDUTL
  1. ;Supported IA #10103 NOW^XLFDT
  1. ;Supported IA #2171 $$NNT^XUAF4
  1. ;
  1. EN1(RADAS,RARM) ;retrieve data from Clin. Rem.'s new style index "ACR"
  1. ; Input:
  1. ; RADAS = last subscript of (required), for example:
  1. ; ^PXRMINDX(70,"IP",43,1,2,2920720.1049,"2;DT;7079279.895;P;3;0")
  1. ; ^PXRMINDX(70,"PI",9,3,45,2921204.155,"9;DT;7078795.8449;P;1;0")
  1. ; RARM = array name passed by reference (required)
  1. ; Output:
  1. ; RARM("aaa") = external value, eg.:
  1. ; RARM("EXAM D/T") = Exam Date and time in yyymmdd.hhmm format
  1. ; RARM("EXAM STATUS") = Exam Status name
  1. ; RARM("PROCEDURE") = Procedure name
  1. ; RARM("INTERPRETING PHYSICIAN") = Primary Staff; else Primary Resident
  1. ; If exam node doesn't exist, then RARM is undefined
  1. ; RARM("RPT STATUS") = Report status name
  1. ; RARM("DIV") = Rad/Nuc Med Division Name (file 4) ^ Station #
  1. ; RARM("I-LOC") = Imaging Location name
  1. ;
  1. K RARM ; clear output var
  1. ; validate RADAS string
  1. Q:$P(RADAS,";",2)'="DT" Q:$P(RADAS,";",4)'="P" Q:$P(RADAS,";",6)'="0"
  1. N RA0,RADFN,RADTI,RACNI,X,I,J,RARPT,RAY2
  1. S RADFN=$P(RADAS,";"),RADTI=$P(RADAS,";",3),RACNI=$P(RADAS,";",5)
  1. S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) Q:RAY2=""
  1. ;* begin P156 *
  1. ;RAD/NUC MED DIVISION (#79) pointer --> $P(RAY2,U,3) DINUM'ed RA5P153
  1. S RARM("DIV")=$$NNT^XUAF4(+$P(RAY2,U,3)) ;division name (file 4)
  1. ;IMAGING LOCATION (#79.1) --> $P(RAY2,U,4)
  1. S RARM("I-LOC")=$$GET1^DIQ(79.1,+$P(RAY2,U,4),.01) ;(if X = 0 or null func returns null)
  1. ;* end P156/gjc
  1. S RA0=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. Q:RA0=""
  1. S RARM("EXAM D/T")=9999999.9999-RADTI
  1. S RARM("EXAM STATUS")=$P($G(^RA(72,+$P(RA0,U,3),0)),U)
  1. S RARM("PROCEDURE")=$P($G(^RAMIS(71,+$P(RA0,U,2),0)),U)
  1. S X=$S($P(RA0,U,15):+$P(RA0,U,15),$P(RA0,U,12):+$P(RA0,U,12),1:"")
  1. S:X'="" X=$$GET1^DIQ(200,X,.01)
  1. S RARM("INTERPRETING PHYSICIAN")=X
  1. ;
  1. ; RARM("PDX")=Primary DX text
  1. ; this node won't exist if there's no data for Prim DX
  1. ; RARM("SDX",n)=Secondary DX text at ^RADPT(-,"DT",-,"P",-,"DX",n,0)
  1. ; the n may have gaps if a Secondary DX was deleted
  1. ;
  1. S RARPT=$P(RA0,U,17) S RARM("RPT STATUS")=$$UL^RAO7PC1A($$RSTAT^RAO7PC1A())
  1. S:$P(RA0,U,13)'="" RARM("PDX")=$P($G(^RA(78.3,+$P(RA0,U,13),0)),U)
  1. S I=0
  1. 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)
  1. Q
  1. ;===============================================================
  1. ; RAD section copied from former location RAD^PXRMSXRO
  1. RAD ;Build the index for RAD/NUC MED PATIENT.
  1. N D0,D1,D2,DA,DAS,DFN,END,ENTRIES,GLOBAL,IND,NE,NERROR,PROC
  1. N START,TEMP,TENP,TEXT
  1. ;Don't leave any old stuff around.
  1. K ^PXRMINDX(70)
  1. S GLOBAL=$$GET1^DID(70,"","","GLOBAL NAME")
  1. S ENTRIES=$P(^RADPT(0),U,4)
  1. S TENP=ENTRIES/10
  1. S TENP=+$P(TENP,".",1)
  1. I TENP<1 S TENP=1
  1. D BMES^XPDUTL("Building index for RAD DATA")
  1. S TEXT="There are "_ENTRIES_" entries to process."
  1. D MES^XPDUTL(TEXT)
  1. S START=$H
  1. S (D0,IND,NE,NERROR)=0
  1. F S D0=+$O(^RADPT(D0)) Q:D0=0 D
  1. . S IND=IND+1
  1. . I IND#TENP=0 D
  1. .. S TEXT="Processing entry "_IND
  1. .. D MES^XPDUTL(TEXT)
  1. . I IND#10000=0 W "."
  1. . S DFN=$P($G(^RADPT(D0,0)),U,1)
  1. . I DFN="" D Q
  1. .. S ETEXT=D0_" no patient"
  1. .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q
  1. . S D1=0
  1. . F S D1=+$O(^RADPT(D0,"DT",D1)) Q:D1=0 D
  1. .. S DATE=$P($G(^RADPT(D0,"DT",D1,0)),U,1)
  1. .. S DA=D0_";DT;"_D1
  1. .. I DATE="" D Q
  1. ... S ETEXT=DA_" no date"
  1. ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q
  1. .. S D2=0
  1. .. F S D2=+$O(^RADPT(D0,"DT",D1,"P",D2)) Q:D2=0 D
  1. ... S TEMP=$G(^RADPT(D0,"DT",D1,"P",D2,0))
  1. ... S DAS=DA_";P;"_D2_";0"
  1. ... S PROC=$P(TEMP,U,2)
  1. ... I PROC="" D Q
  1. .... S ETEXT=DAS_" no procedure"
  1. .... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q
  1. ... S ^PXRMINDX(70,"IP",PROC,DFN,DATE,DAS)=""
  1. ... S ^PXRMINDX(70,"PI",DFN,PROC,DATE,DAS)=""
  1. ... S NE=NE+1
  1. S END=$H
  1. S TEXT=NE_" RAD/NUC MED PATIENT results indexed."
  1. D MES^XPDUTL(TEXT)
  1. D DETIME^PXRMSXRM(START,END)
  1. ;If there were errors send a message.
  1. I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
  1. ;Send a MailMan message with the results.
  1. D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
  1. S ^PXRMINDX(70,"GLOBAL NAME")=$$GET1^DID(70,"","","GLOBAL NAME")
  1. S ^PXRMINDX(70,"BUILT BY")=DUZ
  1. S ^PXRMINDX(70,"DATE BUILT")=$$NOW^XLFDT
  1. Q
  1. ;
  1. ;===============================================================
  1. KRAD(X,DA) ;Delete index for RAD/NUC MED PATIENT file.
  1. N DAS,DATE
  1. S DATE=9999999.9999-DA(1)
  1. S DAS=DA(2)_";DT;"_DA(1)_";P;"_DA_";0"
  1. K ^PXRMINDX(70,"IP",X(1),DA(2),DATE,DAS)
  1. K ^PXRMINDX(70,"PI",DA(2),X(1),DATE,DAS)
  1. Q
  1. ;
  1. ;===============================================================
  1. SRAD(X,DA) ;Set index for RAD/NUC MED PATIENT file.
  1. ;DA(2)=DFN, DA(1)=EXAM DATE (inverse date), DA=Examinations Entry
  1. ;X(1)=PROCEDURE
  1. N DAS,DATE
  1. S DATE=9999999.9999-DA(1)
  1. S DAS=DA(2)_";DT;"_DA(1)_";P;"_DA_";0"
  1. S ^PXRMINDX(70,"IP",X(1),DA(2),DATE,DAS)=""
  1. S ^PXRMINDX(70,"PI",DA(2),X(1),DATE,DAS)=""
  1. Q
  1. ;