Routine: GMTSRASE

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

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

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")

FORMAT ; Calls ^DIWP to format each line of text

 N DIWF,DIWL,DIWR

 S DIWF="C73R",DIWL=3,DIWR=76 D ^DIWP

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRASE   1212     printed  Mar 13, 2025@21:04:50                                                                                                                                                                                                    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

GMTSRASE.m