source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRASE.m@ 1450

Last change on this file since 1450 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1GMTSRASE ; SLC/JER - Selected Radiology Extract ;2/28/91 15:52
2 ;;2.5;Health Summary;;Dec 16, 1992
3MAIN ; Controls branching and execution
4 N GMIDT,GMW,GMPN
5 K ^TMP("RASE",$J)
6 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
7 Q
8GET ; Gets data associated with study and sets ^TMP("RASE",$J,
9 N GMED,GMRP,GMST,GMPTR,GMW,GMI
10 S GMED=+^RADPT(DFN,"DT",GMIDT,0)
11 S GMRP=$P(^RADPT(DFN,"DT",GMIDT,"P",GMPN,0),U,2),GMST=$P(^(0),U,3),GMPTR=$P(^(0),U,17)
12 S GMRP=$S($D(^RAMIS(71,+GMRP,0)):$P(^(0),U,1),1:"UNKNOWN")
13 S GMST=$S($D(^RA(72,+GMST,0)):$P(^(0),U,1),1:"UNKNOWN")
14 S ^TMP("RASE",$J,GMIDT,GMPN,0)=GMED_U_GMRP_U_GMST
15 I $D(^RARPT(+GMPTR,"I",0)) D GETIMP
16 Q
17GETIMP ; Gets Radiologist's Impression
18 N GMLN,GMW
19 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
20 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)
21 K ^UTILITY($J,"W")
22 Q
23FORMAT ; Calls ^DIWP to format each line of text
24 N DIWF,DIWL,DIWR
25 S DIWF="C73R",DIWL=3,DIWR=76 D ^DIWP
26 Q
Note: See TracBrowser for help on using the repository browser.