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

RARTR.m

Go to the documentation of this file.
  1. RARTR ;HISC/CAH COLUMBIA/REB AISC/MJK,RMO - Queue/print Reports ; Jun 17, 2024@12:00:07
  1. ;;5.0;Radiology/Nuclear Medicine;**5,13,16,27,43,55,75,92,99,210,216**;Mar 16, 1998;Build 2
  1. ;Supported IA #2056 reference to GET1^DIQ
  1. PRT ; Begin print/build of e-mail message
  1. ;
  1. ; ** NOTE: If the layout of this output is changed **
  1. ; ** please check that routine RAO7PC3 is **
  1. ; ** not affected. It assumes fixed format of **
  1. ; ** the following headings: **
  1. ; ** Clinical History: **
  1. ; ** Report: **
  1. ; ** Impression: **
  1. ; ** Primary Diagnostic Code: **
  1. ; ** Secondary Diagnostic Codes: **
  1. ; ** Primary Interpreting Staff: **
  1. ;
  1. Q:'$D(^RARPT(+$G(RARPT),0))
  1. ; Use and Set if running in the foreground and Writing to the device
  1. I '$D(RAUTOE) D
  1. . U IO
  1. . S RAFFLF=IOF
  1. . S RAORIOF=RAFFLF
  1. ;
  1. W:$Y>0&('$D(RAUTOE)) @RAFFLF ; If RAUTOE defined build mail msg
  1. S X=$G(^RARPT(+$G(RARPT),0)) ; RAORIOF=RAFFLF
  1. ;
  1. ;S RAFFLF=$S('$D(ORACTION):RAFFLF,ORACTION'=8:RAFFLF,1:"!")
  1. D INIT ; setup exam/report variables
  1. ;p210/KLM - Add Facility Contact Data for FDA mammograpgy requirement
  1. I '$D(RAUTOE) D
  1. .N RADIVDA,RACRM S RADIVDA=$P(^RADPT(RADFN,"DT",RADTI,0),U,3)
  1. .S RACRM=$P($G(^RA(79.1,$P(^RADPT(RADFN,"DT",RADTI,0),U,4),0)),U,21) ;p216/KLM - data check
  1. .I $G(RAST)'="EF",(RACRM'=2) D HDRFAC^RARTR0(RADIVDA)
  1. .Q ;end 210
  1. ;start p99
  1. I $$PTSEX^RAUTL8(RADFN)="F",'$D(RAUTOE) D
  1. .N RA700332,RA700380 S RA700332=$$GET1^DIQ(70.03,$G(RACNI)_","_$G(RADTI)_","_$G(RADFN),32)
  1. .W:RA700332'="" !,"Pregnancy Screen: ",RA700332
  1. .S RA700380=$$GET1^DIQ(70.03,$G(RACNI)_","_$G(RADTI)_","_$G(RADFN),80)
  1. .I (RA700332'="Patient answered no"),(RA700380'="") S RA700380="Pregnancy Screen Comment: "_RA700380 D OUTTEXT^RAUTL9(RA700380,"",1,75,"","!","")
  1. .W !
  1. ;end of p99
  1. I RAY0<0!(RAY1<0)!(RAY2<0)!(RAY3<0) K RAFFLF Q ; data nodes missing
  1. ;
  1. PRT1 I $D(RAUTOE) D
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "
  1. . I $D(RADDEN) D
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Report Unverified by: "_$P($G(^VA(200,$S($G(RADUZ):RADUZ,1:DUZ),0)),"^")
  1. .. Q
  1. . Q
  1. I +$O(^RARPT(RARPT,"ERR",0)) D
  1. . S RAERRFLG="" ; set for future reference (display AMENRPT^RARTR text)
  1. . W:'$D(RAUTOE) !!?10,$$AMENRPT^RARTR2(),!
  1. . I $D(RAUTOE) D
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$$AMENRPT^RARTR2()
  1. .. Q
  1. . Q
  1. I $P(RAY3,"^",25)<2 D G END:$D(RAOOUT)
  1. . D MODS^RAUTL2,OUT1^RARTR3
  1. . D:+$P(RAY3,"^",28) RDIO^RARTUTL(+$P(RAY3,"^",28)) Q:$D(RAOOUT)
  1. . D:+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) PHARM^RARTUTL(RACNI_","_RADTI_","_RADFN_",")
  1. . ;W:'$D(RAUTOE) !
  1. . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. . Q
  1. I $P(RAY3,"^",25)>1 D
  1. . D MEMS1^RARTR3
  1. . W:'$D(RAUTOE) !
  1. . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. . Q
  1. G END:$D(RAOOUT)
  1. ; Check for duplicate history in file 70 and 74.
  1. D CHKDUPHX^RART1 ; Sets RADUPHX to 1 for duplicate or 0 if different.
  1. F RAP="H","AH","R","I" K ^UTILITY($J,"W"),^(1) D G END:$D(RAOOUT)
  1. . S RAP("P")=$S(RAP="H":"Clinical History:",RAP="AH":"Additional Clinical History:",RAP="R":"Report:",1:"Impression:")
  1. . ; Don't continue if printing Additional Clinical History and it is a
  1. . ; duplicate of Clinical History.
  1. . Q:RAP="AH"&(RADUPHX>0)
  1. . W:'$D(RAUTOE) !?RATAB,RAP("P")
  1. . I $D(RAUTOE),($D(RADDEN)),(RAP="R") D
  1. .. N RABAN1,RABAN2,RASPCE S $P(RASPCE," ",46)=""
  1. .. S RABAN1="*** Uncorrected Version ***"
  1. .. S RABAN2="*** Refer to final report ***"
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RASPCE_RABAN1
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RASPCE_RABAN2
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. .. Q
  1. . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_RAP("P")
  1. . W:$D(RASTFL)&(RAP="R")&('$D(RAUTOE)) ?45,"Status: ",$$XTERNAL^RAUTL5(RAST,$P($G(^DD(74,5,0)),"^",2))
  1. . I RAP="R",($D(RAUTOE)) D
  1. .. S $P(RAP("S")," ",(46-$L(^TMP($J,"RA AUTOE",RAACNT))))=""
  1. .. I '$D(RADDEN) S ^TMP($J,"RA AUTOE",RAACNT)=^(RAACNT)_RAP("S")_"Status: "_$$XTERNAL^RAUTL5(RAST,$P($G(^DD(74,5,0)),"^",2))
  1. .. Q
  1. . D:$D(RAUTOE) SET^RARTR2
  1. . D:'$D(RAUTOE) WRITE^RARTR2 Q:$D(RAOOUT)
  1. . K ^UTILITY($J,"W")
  1. . Q
  1. I $D(RADDEN),($G(^RARPT(RARPT,"PURGE"))) D
  1. . ; when the report is unverified and purge data exists (rpt adden)
  1. . N RAPRGE S RAPRGE=+$G(^RARPT(RARPT,"PURGE"))
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Report Purged: "_$$FMTE^XLFDT(RAPRGE,"1P")
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. . Q
  1. I $P($G(^RA(79.1,+$P(RAY2,U,4),0)),U,18)="Y" D PRTDX^RARTR1 G:$D(RAOOUT) END ;print dx codes
  1. D EN1^RARTR0 G:$D(RAOOUT) END
  1. I '$D(RAVERFND) D G END:$D(RAOOUT)
  1. . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD:($Y+RAFOOT+4)>IOSL
  1. . N RADFTSBN,RADFTSBT S:$D(RADDEN) RAVERF=+$P(RA74B4,"^",9)
  1. . S RADFTSBN=$E($P($G(^VA(200,RAVERF,20)),"^",2),1,25)
  1. . S:RADFTSBN']"" RADFTSBN=$E($P($G(^VA(200,RAVERF,0)),"^"),1,25)
  1. . S RADFTSBT=$E($P($G(^VA(200,RAVERF,20)),"^",3),1,30)
  1. . I RADFTSBT']"" S RADFTSBT=$$TITLE^RARTR0(RAVERF)
  1. . W:'$D(RAUTOE) !!,"VERIFIED BY:",!?2,$S(RADFTSBN]"":RADFTSBN,1:"")
  1. . W:RADFTSBT]""&('$D(RAUTOE)) ", "_RADFTSBT
  1. . I $D(RAUTOE) D
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="VERIFIED BY:"
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$S(RADFTSBN]"":RADFTSBN,1:"")_$S(RADFTSBT]"":", "_RADFTSBT,1:"")
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. .. Q
  1. . Q
  1. K RASBPN,RASBT,RASECIEN,RASECOND,RASECSS
  1. I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 G END:$D(RAOOUT) D HD:($Y+RAFOOT+4)>IOSL
  1. W:'$D(RAUTOE) !!,$S($D(^RABTCH(74.2,+RABTCH,0)):$P(^(0),"^"),1:""),"/" I +$G(^RARPT(RARPT,"T")),$D(^VA(200,+$P(^RARPT(RARPT,"T"),"^"),0)) W:'$D(RAUTOE) $P(^(0),"^",2)
  1. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$P($G(^RABTCH(74.2,+RABTCH,0)),"^")_"/"_$S(+$G(^RARPT(RARPT,"T"))&($D(^VA(200,+$P($G(^RARPT(RARPT,"T")),"^"),0))):$P(^(0),"^",2),1:"")
  1. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. D HANG^RARTR2 G END:$D(RAOOUT)
  1. I RAST'="V" D:'$D(RAMDV) SETDIV^RARTR2 I $P(RAMDV,U,25) D WARNING^RARTR1
  1. G PEND:RAST'="PD"
  1. S $P(RASTRSK,"*",80)=""
  1. I '$D(RAUTOE) D
  1. . D HD:($Y+RAFOOT+9)>IOSL
  1. . W !,$E(RASTRSK,1,22)," P R O B L E M S T A T E M E N T ",$E(RASTRSK,1,22)
  1. . W !!,$S($D(^RARPT(RARPT,"P")):^("P"),1:"None entered.") W !!,RASTRSK
  1. . Q
  1. E D
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$E(RASTRSK,1,22)_" P R O B L E M S T A T E M E N T "_$E(RASTRSK,1,22)
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$S($D(^RARPT(RARPT,"P")):^("P"),1:"None entered.")
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. . Q
  1. PEND D FOOT^RARTR2,HANG^RARTR2 D:'$D(RAMIE)&('$D(RAUTOE)) Q^RAFLH1
  1. END K:$D(RAOOUT) XQAID,XQAKILL
  1. K %I,%W,%Y1,C,DN,I,RADXCODE,RARTMES,RAVERF,RAVERFND,RAPVERF
  1. K RAVERS,RAFOOT,RAY0,RAY1,RAY2,RAY3,RALOC,RAFMT,RAMOD,RASTFL,RALB,RALBR
  1. K RALBRT,RALBS,RALBST,RAV,RAP,RATAB,RAXX,VAL,VAR,RADFN,RADTI,RACN,RADTE
  1. K RARPT,RAHDFM,RAFTFM,RAV,RAIOF,RABTCH,RAOOUT,RAPIR,RAPIS,VAERR,Z
  1. ; K RASTRSK S RAFFLF=RAORIOF K RAORIOF,RAFFLF,RAERRFLG
  1. ; 05/15/08 BAY/KAM Patch RA*5*92 Added Conditional Kill to next line
  1. ; to support an AMIE interface (IA 708)
  1. K RASTRSK,RAORIOF,RAFFLF,RAERRFLG K:'($D(RAMIE)#2) DFN
  1. ;the next kill line corrects the CPRS V27 report display issue when repeated
  1. ;on same patient P92
  1. K %,DIW,DIWF,DIWI,DIWL,DIWT,DIWTC,DIWX,RAACNT,RADUPHX,RANUM,RAREZON,RAST
  1. Q
  1. Q ; Queue the report
  1. S ZTDTH=$H,ZTRTN="DQ^RARTR",ZTSAVE("RARPT")="" S:$D(RARTMES) ZTSAVE("RARTMES")=""
  1. D ZIS^RAUTL Q:RAPOP
  1. ;
  1. DQ S U="^",X="T",%DT="" D ^%DT K %DT S DT=Y G PRT
  1. ;
  1. INIT ; initialize exam/report variables
  1. ; main variables set:
  1. ; RAY0: zero node data from the Patient File (2)
  1. ; RAY1: zero node data from the Rad/Nuc Med Patient File (70)
  1. ; RAY2: Registered Exams (70.02) zero node data
  1. ; RAY3: Examinations (70.03) zero node data
  1. S (RAY0,RAY1,RAY2,RAY3)=-1 ; error condition, if no data nodes
  1. S RADFN=+$P(X,"^",2),RADTE=+$P(X,"^",3),RADTI=(9999999.9999-RADTE)
  1. S RACN=+$P(X,"^",4),RAST=$P(X,"^",5),RATAB=5
  1. S:'$D(RABTCH) RABTCH=0 S (DIWL,DIWF)=0
  1. Q:'$D(^RADPT(RADFN,0)) S RANUM=1,RAY1=^(0)
  1. Q:'$D(^DPT(RADFN,0)) S RAY0=^(0)
  1. Q:'$D(^RADPT(RADFN,"DT",RADTI,0)) S RAY2=^(0)
  1. S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
  1. S (RAY3,RALB)=$S($D(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,0)):^(0),1:-1)
  1. Q:RAY3<0 ; examinations data missing
  1. ;
  1. S (RAHDFM,RAFTFM)=1 S:$D(^RA(79.1,+$P(RAY2,"^",4),0)) RAHDFM=^(0),RAFTFM=+$P(RAHDFM,"^",13),DIWL=$P(RAHDFM,"^",14),DIWF=$P(RAHDFM,"^",15),RAHDFM=+$P(RAHDFM,"^",12) S RAFOOT=$S($D(^RA(78.2,RAFTFM,0)):+$P(^(0),"^",2),1:0)
  1. S:'DIWL DIWL=5 S:'DIWF DIWF=70 S DIWF="WC"_(DIWF-DIWL)
  1. G @$S($D(RAUTOE):"HEAD^RARTR0",1:"HD1")
  1. Q
  1. ;
  1. HD D FOOT^RARTR2:$E(IOST,1,2)'="C-"
  1. HD1 S RAFMT=RAHDFM I $D(RARTMES) W:$Y>0 @RAFFLF W !,?((80-$L(RARTMES))/2),RARTMES,! S RAIOF=RAFFLF,RAFFLF="!"
  1. I '$D(RARTMES) W:$Y>0 @RAFFLF
  1. D PRT^RAFLH S:$D(RARTMES) RAFFLF=RAIOF
  1. W:$D(RAERRFLG) !!?10,$$AMENRPT^RARTR2(),!!
  1. Q