GMTSRASE ; SLC/JER - Selected Radiology Extract ;2/28/91 15:52
;;2.5;Health Summary;;Dec 16, 1992
MAIN ; Controls branching and execution
N GMIDT,GMW,GMPN
K ^TMP("RASE",$J)
S GMIDT=0 F GMW=0:0 S GMIDT=$O(^RADPT(DFN,"DT","AP",TEST,GMIDT)) Q:GMIDT'>0 S GMPN=0 F GMW=0:0 S GMPN=$O(^RADPT(DFN,"DT","AP",TEST,GMIDT,GMPN)) Q:GMPN'>0 D GET
Q
GET ; Gets data associated with study and sets ^TMP("RASE",$J,
N GMED,GMRP,GMST,GMPTR,GMW,GMI
S GMED=+^RADPT(DFN,"DT",GMIDT,0)
S GMRP=$P(^RADPT(DFN,"DT",GMIDT,"P",GMPN,0),U,2),GMST=$P(^(0),U,3),GMPTR=$P(^(0),U,17)
S GMRP=$S($D(^RAMIS(71,+GMRP,0)):$P(^(0),U,1),1:"UNKNOWN")
S GMST=$S($D(^RA(72,+GMST,0)):$P(^(0),U,1),1:"UNKNOWN")
S ^TMP("RASE",$J,GMIDT,GMPN,0)=GMED_U_GMRP_U_GMST
I $D(^RARPT(+GMPTR,"I",0)) D GETIMP
Q
GETIMP ; Gets Radiologist's Impression
N GMLN,GMW
K ^UTILITY($J,"W") S GMLN=0 F GMW=0:0 S GMLN=$O(^RARPT(GMPTR,"I",GMLN)) Q:GMLN'>0 S X=^RARPT(GMPTR,"I",GMLN,0) D FORMAT
I $D(^UTILITY($J,"W")) F GMLN=1:1:^UTILITY($J,"W",3) S ^TMP("RASE",$J,GMIDT,GMPN,GMLN)=^UTILITY($J,"W",3,GMLN,0)
K ^UTILITY($J,"W")
Q
FORMAT ; Calls ^DIWP to format each line of text
N DIWF,DIWL,DIWR
S DIWF="C73R",DIWL=3,DIWR=76 D ^DIWP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRASE 1212 printed Sep 23, 2025@19:36:07 Page 2
GMTSRASE ; SLC/JER - Selected Radiology Extract ;2/28/91 15:52
+1 ;;2.5;Health Summary;;Dec 16, 1992
MAIN ; Controls branching and execution
+1 NEW GMIDT,GMW,GMPN
+2 KILL ^TMP("RASE",$JOB)
+3 SET GMIDT=0
FOR GMW=0:0
SET GMIDT=$ORDER(^RADPT(DFN,"DT","AP",TEST,GMIDT))
if GMIDT'>0
QUIT
SET GMPN=0
FOR GMW=0:0
SET GMPN=$ORDER(^RADPT(DFN,"DT","AP",TEST,GMIDT,GMPN))
if GMPN'>0
QUIT
DO GET
+4 QUIT
GET ; Gets data associated with study and sets ^TMP("RASE",$J,
+1 NEW GMED,GMRP,GMST,GMPTR,GMW,GMI
+2 SET GMED=+^RADPT(DFN,"DT",GMIDT,0)
+3 SET GMRP=$PIECE(^RADPT(DFN,"DT",GMIDT,"P",GMPN,0),U,2)
SET GMST=$PIECE(^(0),U,3)
SET GMPTR=$PIECE(^(0),U,17)
+4 SET GMRP=$SELECT($DATA(^RAMIS(71,+GMRP,0)):$PIECE(^(0),U,1),1:"UNKNOWN")
+5 SET GMST=$SELECT($DATA(^RA(72,+GMST,0)):$PIECE(^(0),U,1),1:"UNKNOWN")
+6 SET ^TMP("RASE",$JOB,GMIDT,GMPN,0)=GMED_U_GMRP_U_GMST
+7 IF $DATA(^RARPT(+GMPTR,"I",0))
DO GETIMP
+8 QUIT
GETIMP ; Gets Radiologist's Impression
+1 NEW GMLN,GMW
+2 KILL ^UTILITY($JOB,"W")
SET GMLN=0
FOR GMW=0:0
SET GMLN=$ORDER(^RARPT(GMPTR,"I",GMLN))
if GMLN'>0
QUIT
SET X=^RARPT(GMPTR,"I",GMLN,0)
DO FORMAT
+3 IF $DATA(^UTILITY($JOB,"W"))
FOR GMLN=1:1:^UTILITY($JOB,"W",3)
SET ^TMP("RASE",$JOB,GMIDT,GMPN,GMLN)=^UTILITY($JOB,"W",3,GMLN,0)
+4 KILL ^UTILITY($JOB,"W")
+5 QUIT
FORMAT ; Calls ^DIWP to format each line of text
+1 NEW DIWF,DIWL,DIWR
+2 SET DIWF="C73R"
SET DIWL=3
SET DIWR=76
DO ^DIWP
+3 QUIT
