Changeset 636 for FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLO2.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLO2.m (modified) (1 diff)

FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLO2.m

@@ -1 +1 @@
 RAHLO2 ;HIRMFO/GJC-File rpt (data from bridge program) ;10/30/97  09:02
- ;;5.0;Radiology/Nuclear Medicine;**55,80,84**;Mar 16, 1998;Build 13
- ;
- ;Integration Agreements
- ;----------------------
- ;$$FIND1^DIC(2051); UPDATE^DIE(2053); $$DT^XLFDT(10103); $$UP^XLFSTR(10104)
- ;
-ADENDUM ; This functions store new lines of text at the end of the existing 
- ;impression and report text. If this report is being amended through the
- ;teleradiology service, add the addendum text to the IMPRESSION TEXT (#300)
- ;field only. Note: Only ADENDUM was edited for RA*5.0*84 gjc/09.18.07
- N A,COUNTER,I,J,NODE,ROOT,SUB,X,Y
- ;NODE = ^RARPT(RARPT,"I" -or- "R"  -> where the data is to be stored...
- ;ROOT = ^TMP("RARPT-REC",$J,RASUB  -> where the addendum data resides...
- F A="I","R" D  K I,J
- .S SUB=$S(A="I":"RAIMP",1:"RATXT"),ROOT=$NA(^TMP("RARPT-REC",$J,RASUB,SUB)) Q:'$O(@ROOT@(0))
- .S NODE=$NA(^RARPT(RARPT,A))
- .S COUNTER=+$O(@NODE@($C(32)),-1) ;last record #
- .;
- .;if there is existing text, add a null line for space.
- .I '($D(I)#2),(COUNTER>0) S COUNTER=COUNTER+1,@NODE@(COUNTER,0)=$C(32),I=""
- .;
- .S Y=0 F  S Y=$O(@ROOT@(Y)) Q:'Y  D
- ..S X=@ROOT@(Y)
- ..;if addendum text is to be the original text no spacer is needed ('Addendum:' tag applied)
- ..;if prior report or impression text exist, insert a blank as a spacer
- ..;^RARPT(RARPT,"I",1,0)="original impression"
- ..;^RARPT(RARPT,"I",2,0)="" <- insert a null line as a spacer
- ..;^RARPT(RARPT,"I",3,0)="Addendum: first line of addendum" ** NOTE 'Addendum:' tag **
- ..;^RARPT(RARPT,"I",4,0)="second line of addendum"
- ..;...
- ..;^RARPT(RARPT,"I",N,0)="Nth and last line of addendum"
- ..S COUNTER=COUNTER+1
- ..;set the first line of the addendum w/header: 'Addendum: '
- ..I '($D(J)#2) S X="Addendum: "_X,J=""
- ..S @NODE@(COUNTER,0)=X
- ..Q
- .S @NODE@(0)="^^"_COUNTER_"^"_COUNTER_"^"_$$DT^XLFDT()
- .Q
+ ;;5.0;Radiology/Nuclear Medicine;**55,80**;Mar 16, 1998;Build 19
+ADENDUM ; store new lines at the end of existing text
+ F A="I","R" D
+ . I $O(^TMP("RARPT-REC",$J,RASUB,$S(A="I":"RAIMP",1:"RATXT"),0)) D
+ .. S RACNT=+$O(^RARPT(RARPT,A,9999999),-1),RASTRNDE=RACNT+1
+ .. ; Check if the impression an/or report text sent with the addendum
+ .. ; is to be the initial text added to the word processing multiples.
+ .. ; RASTRNDE=the first subscript where impression/report data is to
+ .. ; be stored.  If no existing impression/report text data, RASTRNDE
+ .. ; equals one.  If one & RACNT equals one, don't add a blank line
+ .. ; before adding addendum text.  If RASTRNDE & RACNT both >1, add
+ .. ; the blank line.
+ .. S I=0 F  S I=$O(^TMP("RARPT-REC",$J,RASUB,$S(A="I":"RAIMP",1:"RATXT"),I)) Q:I'>0  D
+ ... S RACNT=RACNT+1,L=$G(^TMP("RARPT-REC",$J,RASUB,$S(A="I":"RAIMP",1:"RATXT"),I))
+ ... S:I=$O(^TMP("RARPT-REC",$J,RASUB,$S(A="I":"RAIMP",1:"RATXT"),0)) L="Addendum: "_L ; if the first line, append 'addendum:'
+ ... I (RASTRNDE=RACNT),(RACNT>1) S ^RARPT(RARPT,A,RACNT,0)=" ",RACNT=RACNT+1
+ ... S ^RARPT(RARPT,A,RACNT,0)=L
+ ... Q
+ .. S ^RARPT(RARPT,A,0)="^^"_RACNT_"^"_RACNT_"^"_RADATE
+ .. Q
+ . Q
+ K A,I,L,RACNT,RASTRNDE
  Q
- ;
 ERR(A) ; Invalid impression/report text message.
  ; Input: 'A' - either "I" for impression, or "R" for report