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

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