| 1 | RAHLO2 ;HIRMFO/GJC-File rpt (data from bridge program) ;10/30/97 09:02
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**55,80**;Mar 16, 1998;Build 19
|
|---|
| 3 | ADENDUM ; store new lines at the end of existing text
|
|---|
| 4 | F A="I","R" D
|
|---|
| 5 | . I $O(^TMP("RARPT-REC",$J,RASUB,$S(A="I":"RAIMP",1:"RATXT"),0)) D
|
|---|
| 6 | .. S RACNT=+$O(^RARPT(RARPT,A,9999999),-1),RASTRNDE=RACNT+1
|
|---|
| 7 | .. ; Check if the impression an/or report text sent with the addendum
|
|---|
| 8 | .. ; is to be the initial text added to the word processing multiples.
|
|---|
| 9 | .. ; RASTRNDE=the first subscript where impression/report data is to
|
|---|
| 10 | .. ; be stored. If no existing impression/report text data, RASTRNDE
|
|---|
| 11 | .. ; equals one. If one & RACNT equals one, don't add a blank line
|
|---|
| 12 | .. ; before adding addendum text. If RASTRNDE & RACNT both >1, add
|
|---|
| 13 | .. ; the blank line.
|
|---|
| 14 | .. S I=0 F S I=$O(^TMP("RARPT-REC",$J,RASUB,$S(A="I":"RAIMP",1:"RATXT"),I)) Q:I'>0 D
|
|---|
| 15 | ... S RACNT=RACNT+1,L=$G(^TMP("RARPT-REC",$J,RASUB,$S(A="I":"RAIMP",1:"RATXT"),I))
|
|---|
| 16 | ... S:I=$O(^TMP("RARPT-REC",$J,RASUB,$S(A="I":"RAIMP",1:"RATXT"),0)) L="Addendum: "_L ; if the first line, append 'addendum:'
|
|---|
| 17 | ... I (RASTRNDE=RACNT),(RACNT>1) S ^RARPT(RARPT,A,RACNT,0)=" ",RACNT=RACNT+1
|
|---|
| 18 | ... S ^RARPT(RARPT,A,RACNT,0)=L
|
|---|
| 19 | ... Q
|
|---|
| 20 | .. S ^RARPT(RARPT,A,0)="^^"_RACNT_"^"_RACNT_"^"_RADATE
|
|---|
| 21 | .. Q
|
|---|
| 22 | . Q
|
|---|
| 23 | K A,I,L,RACNT,RASTRNDE
|
|---|
| 24 | Q
|
|---|
| 25 | ERR(A) ; Invalid impression/report text message.
|
|---|
| 26 | ; Input: 'A' - either "I" for impression, or "R" for report
|
|---|
| 27 | ; Output: the appropriate error message
|
|---|
| 28 | Q "Invalid "_$S(A="I":"Impression",1:"Report")_" Text"
|
|---|
| 29 | ;
|
|---|
| 30 | DIAG ; Check if the Diagnostic Codes passed are valid. Set RADX equal
|
|---|
| 31 | ; to primary Dx code pntr value. Set RASECDX(x) to the secondary
|
|---|
| 32 | ; Dx code(s) if any.
|
|---|
| 33 | N RAXFIRST
|
|---|
| 34 | S I=0,RAXFIRST=1
|
|---|
| 35 | K RASECDX
|
|---|
| 36 | F S I=$O(^TMP("RARPT-REC",$J,RASUB,"RADX",I)) Q:I'>0 D Q:$D(RAERR)
|
|---|
| 37 | . S RADIAG=$G(^TMP("RARPT-REC",$J,RASUB,"RADX",I))
|
|---|
| 38 | . ;S:RADIAG']"" RAERR="Missing Diagnostic Code" Q:$D(RAERR)
|
|---|
| 39 | . Q:RADIAG']"" ;Missing Diagnostic Code Patch 80
|
|---|
| 40 | . ; If RADXIEN is a number, set RADXIEN to what is assumed to be a
|
|---|
| 41 | . ; valid pointer (ien) for file 78.3
|
|---|
| 42 | . I +RADIAG=RADIAG S RADXIEN=RADIAG
|
|---|
| 43 | . ; If RADIAG is in a free text format, convert the external value
|
|---|
| 44 | . ; into the ien for file 78.3
|
|---|
| 45 | . I +RADIAG'=RADIAG S RADXIEN=$$FIND1^DIC(78.3,"","X",RADIAG)
|
|---|
| 46 | . I '$D(^RA(78.3,RADXIEN,0)) S RAERR="Invalid Diagnostic Code" Q
|
|---|
| 47 | . IF RAXFIRST S RADX=RADXIEN,RAXFIRST=0 Q ; RADX=pri. Dx Code
|
|---|
| 48 | . ; are any of the sec. Dx codes equal to our pri. Dx code?
|
|---|
| 49 | . ;S:RADXIEN=RADX RAERR="Secondary Dx codes must differ from the primary Dx code." Q:$D(RAERR)
|
|---|
| 50 | . Q:RADXIEN=RADX ;Secondary Dx codes must differ from the primary Dx code Patch 80
|
|---|
| 51 | . ;S:$D(RASECDX(RADXIEN))#2 RAERR="Duplicate secondary Dx codes." Q:$D(RAERR)
|
|---|
| 52 | . Q:$D(RASECDX(RADXIEN))#2 ;Duplicate secondary Dx codes. Patch 80
|
|---|
| 53 | . S RASECDX(RADXIEN)="" ; set the sec. Dx array
|
|---|
| 54 | . Q
|
|---|
| 55 | K I,RADIAG,RADXIEN
|
|---|
| 56 | Q
|
|---|
| 57 | SECDX ; Kill old sec. Dx nodes, and add the new ones into the 70.14 multiple
|
|---|
| 58 | ; called from RAHLO. Needs RADFN,RADTI & RACNI to function.
|
|---|
| 59 | Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))
|
|---|
| 60 | I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)) D KILSECDG^RAHLO4
|
|---|
| 61 | ;K RAFDA N RAX S RAX=0,RAFDA(70,"?1,",.01)=RADFN
|
|---|
| 62 | ;S RAFDA(70.02,"?2,?1,",.01)=(9999999.9999-RADTI)
|
|---|
| 63 | ;S RAFDA(70.03,"?3,?2,?1,",.01)=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^")
|
|---|
| 64 | ;F S RAX=$O(RASECDX(RAX)) Q:RAX'>0 D
|
|---|
| 65 | ;. S RAFDA(70.14,"?"_RAX_"9,?3,?2,?1,",.01)=RAX
|
|---|
| 66 | ;. Q
|
|---|
| 67 | ;D UPDATE^DIE("","RAFDA",,"RAERR")
|
|---|
| 68 | ;I $D(RAERR) M ^TMP("ERR")=RAERR
|
|---|
| 69 | ;
|
|---|
| 70 | N RAX S RAX=0
|
|---|
| 71 | N RAFDA,RA2
|
|---|
| 72 | K RAFDA
|
|---|
| 73 | ; K ^TMP("RAERR",$J)
|
|---|
| 74 | S RA2=RACNI_","_RADTI_","_RADFN
|
|---|
| 75 | F S RAX=$O(RASECDX(RAX)) Q:RAX'>0 D
|
|---|
| 76 | . S RAFDA(70.14,"?+"_RAX_"9,"_RA2_",",.01)=RAX
|
|---|
| 77 | D UPDATE^DIE("","RAFDA",,"RAERR")
|
|---|
| 78 | ; I $D(RAERR) M ^TMP("RAERR",$J)=RAERR
|
|---|
| 79 | ;
|
|---|
| 80 | Q
|
|---|
| 81 | IMPTXT ; Check if the impression text consists only of the string
|
|---|
| 82 | ; 'impression:". If 'impression:' is the only set of characters,
|
|---|
| 83 | ; (spaces are excluded) then delete the "RAIMP" node.
|
|---|
| 84 | N RA1 S RA1=$O(^TMP("RARPT-REC",$J,RASUB,"RAIMP",0))
|
|---|
| 85 | Q:'RA1 N RAIMP S RAIMP=$G(^TMP("RARPT-REC",$J,RASUB,"RAIMP",RA1))
|
|---|
| 86 | I $$UP^XLFSTR($E(RAIMP,1,11))="IMPRESSION:" D
|
|---|
| 87 | . S $E(RAIMP,1,11)="" ; strip out 'impression:' if it is the first
|
|---|
| 88 | . ; eleven chars of the impression text
|
|---|
| 89 | . ; now strip off leading spaces from the remaining
|
|---|
| 90 | . ; text that led with 'impression:' if present
|
|---|
| 91 | . F I1=1:1 S:$E(RAIMP,I1)'=" " RAIMP=$E(RAIMP,I1,99999) Q:$E(RAIMP)'=" "
|
|---|
| 92 | . S ^TMP("RARPT-REC",$J,RASUB,"RAIMP",RA1)=RAIMP
|
|---|
| 93 | . Q
|
|---|
| 94 | Q:$O(^TMP("RARPT-REC",$J,RASUB,"RAIMP",RA1)) ; more imp. text follows
|
|---|
| 95 | K:$G(^TMP("RARPT-REC",$J,RASUB,"RAIMP",RA1))="" ^TMP("RARPT-REC",$J,RASUB,"RAIMP",RA1) ; if only "RAIMP" node null, delete "RAIMP" node
|
|---|
| 96 | Q
|
|---|
