source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORDV08A.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1ORDV08A ; slc/dan Medicine procedure component ;8/13/01 14:42
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109**;Dec 17,1997
3GETREC(MCL,RMAR,TV,VV,SP) ; Return Single Record
4 N LOOP,LINE,LINENO
5 S LOOP="",LINENO=1
6 S ORDATE=$$RETURN("DATE/TIME",MCL)
7 S ORSUM=$$RETURN("SUMMARY",MCL)
8 S ORPROC=$$RETURN("PROCEDURE",MCL)
9 ;S ^TMP("ORTEMP",$J,LINENO)="",LINENO=LINENO+1
10 F S LOOP=+$O(^TMP("MCAR",$J,MCL,LOOP)) Q:LOOP=0 D REPORT(LOOP,MCL,RMAR,TV,VV,SP)
11 Q
12REPORT(LOOP,MCL,RMAR,TV,VV,SP) ; Report for Procedure
13 N LINE,TEMP,HOLD,TITLE,VALUE,UNITS,MLEN,RANGE
14 N TARRAY,VARRY,LARRAY,TMAX,VMAX,MAX,LOOP2
15 S LINE=^TMP("MCAR",$J,MCL,LOOP,1)
16 S TEMP=$P(LINE,U,1),TITLE=$P(TEMP,";",1)_":"
17 S VALUE=$P(LINE,U,3,255),UNITS=$P(LINE,U,2)
18 I $P(TEMP,";",2)="W" D WORD(MCL,LOOP,TITLE,RMAR,TV,VV,SP) Q
19 S VALUE=VALUE_$S(UNITS="":"",1:" "_UNITS)
20 D PRINT(VALUE,VV,TITLE,TV,SP)
21 S ^TMP("ORTEMP",$J,LINENO)="",LINENO=LINENO+1
22 Q
23WARP(VALUE,LENGTH,TEMP,MAX) ; Warp a field
24 N DIWL,DIWR,DIWF,X,LOOP3,TEMP1 S LOOP3=""
25 K ^UTILITY($J,"W")
26 S DIWL=0,DIWR=LENGTH,X=VALUE D ^DIWP
27 F MAX=1:1 S LOOP3=+$O(^UTILITY($J,"W",DIWL,LOOP3)) Q:LOOP3=0 D
28 . S TEMP1=^UTILITY($J,"W",DIWL,LOOP3,0)
29 . S:$E(TEMP1,$L(TEMP1))=" " TEMP1=$E(TEMP1,1,$L(TEMP1)-1)
30 . S TEMP(LOOP3)=TEMP1
31 S MAX=MAX-1
32 Q
33WORD(MCL,LOOP,TITLE,RMAR,TV,VV,SP) ; Display Word Processing
34 N SLOOP,X,DIWR,DIWL,DIWF,TARRAY,TMAX,LOOP3,SPAC,SPACE
35 D WARP(TITLE,TV,.TARRAY,.TMAX) K ^UTILITY($J,"W") S DIWR=VV,DIWL=0
36 F SLOOP=0:0 S SLOOP=+$O(^TMP("MCAR",$J,MCL,LOOP,SLOOP)) Q:SLOOP=0 D
37 . S X=$P(^TMP("MCAR",$J,MCL,LOOP,SLOOP),U,3) D ^DIWP
38 S SLOOP=0
39 F LOOP3=1:1 S SLOOP=+$O(^UTILITY($J,"W",DIWL,SLOOP)) Q:'SLOOP D
40 . K SPACE S $P(SPACE," ",SP)=" " S ^TMP("ORTEMP",$J,LINENO)=$J($G(TARRAY(LOOP3)),TV)_SPACE_^UTILITY($J,"W",DIWL,SLOOP,0),LINENO=LINENO+1
41 S ^TMP("ORTEMP",$J,LINENO)="",LINENO=LINENO+1
42 Q
43CONVERT(TITLE) ; Convert to Mixed Case TEMP = Temp
44 N UPPER,LOWER,TEMP,LOOP,HOLD,HOLD2
45 S UPPER="ABCDEFGHIJKLMNOPQRSTUVWXYZ",LOWER="abcdefghijklmnopqrstuvwxyz"
46 F LOOP=1:1:255 S HOLD=$P(TITLE," ",LOOP) Q:HOLD="" D
47 . S:$D(TEMP) TEMP=TEMP_" "
48 . S HOLD2=$E(HOLD,2,$L(HOLD))
49 . S TEMP=$G(TEMP)_$E(HOLD,1)_$TR(HOLD2,UPPER,LOWER)
50 Q TEMP
51PRINT(VALUE,VV,TITLE,TV,SP) ; Print a Field and its Value
52 N VMAX,TMAX,TARRAY,VARRAY,SPAC,LOOP2,SPACE
53 S TITLE=$$CONVERT(TITLE)
54 D WARP(VALUE,VV,.VARRAY,.VMAX)
55 D WARP(TITLE,TV,.TARRAY,.TMAX)
56 S MAX=$S(VMAX<TMAX:TMAX,VMAX>TMAX:VMAX,1:TMAX)
57 S SPAC=TMAX-VMAX S SPAC=$S(SPAC'>0:0,1:SPAC)
58 F LOOP2=1:1:MAX D
59 . K SPACE S $P(SPACE," ",SP)=" ",^TMP("ORTEMP",$J,LINENO)=$J($G(TARRAY(LOOP2)),TV)_SPACE_$G(VARRAY(LOOP2-SPAC)),LINENO=LINENO+1
60 Q:$D(GMTSQIT)
61 Q
62RETURN(TYPE,LINE) ; Return key Elements
63 N MCHOLD,HOLD
64 S MCHOLD=+$O(^TMP("MCAR",$J,LINE,"B",TYPE,""))
65 S HOLD=$P($G(^TMP("MCAR",$J,LINE,MCHOLD,1)),U,3)
66 K ^TMP("MCAR",$J,LINE,"B",TYPE,LINE)
67 K ^TMP("MCAR",$J,LINE,MCHOLD,1)
68 Q HOLD
69EXIT ; Clean up and Quit
70 K PR,OT,DA,MCARPPS,MCI,MCJ,R,MCL,S1,S2,S4,S5,S6,LL,LL1,MAX,VA
71 K ^TMP("MCAR",$J),K,N,MCARDT,MCARNM,MCARPROC,M,RMAR
72 Q
Note: See TracBrowser for help on using the repository browser.