| 1 | GMTSMCPS ; WISC/DCB - Medicine 2.2 Health Summary Component ; 08/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**16,56**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10061 KVAR^VADPT
|
|---|
| 6 | ; DBIA 80 ^MCAR(690
|
|---|
| 7 | ; DBIA 10011 ^DIWP
|
|---|
| 8 | ;
|
|---|
| 9 | BEG ; One Line summary only
|
|---|
| 10 | D START(0,"B") Q
|
|---|
| 11 | BRIEF ; Brief Summary
|
|---|
| 12 | D START(1,"B") Q
|
|---|
| 13 | ABN ; Print Brief summary for only abnormal or Null
|
|---|
| 14 | D START(2,"B") Q
|
|---|
| 15 | FULL ; Full Summary
|
|---|
| 16 | D START(1,"F") Q
|
|---|
| 17 | CAP ; Capture
|
|---|
| 18 | D START(1,"C") Q
|
|---|
| 19 | ADBF ; Print Full Summary for only abnormal or null
|
|---|
| 20 | D START(2,"F") Q
|
|---|
| 21 | ;
|
|---|
| 22 | START(BRIEF,MCTYPE) ; Get the record and display the record
|
|---|
| 23 | N TV,VV,SP,MAX
|
|---|
| 24 | K ^TMP("MCAR",$J)
|
|---|
| 25 | S RMAR=$S($D(IOM):IOM,1:IOM)
|
|---|
| 26 | S TV=(.25*RMAR+.5)\1
|
|---|
| 27 | S VV=(.70*RMAR+.5)\1
|
|---|
| 28 | S SP=(RMAR-(TV+VV))-1
|
|---|
| 29 | D KVAR^VADPT
|
|---|
| 30 | I '$D(^MCAR(690,"AC",DFN)) D EXIT Q
|
|---|
| 31 | D SEARCH
|
|---|
| 32 | I '$D(^TMP("MCAR",$J)) D EXIT Q
|
|---|
| 33 | F MCL=1:1 Q:$D(GMTSQIT) Q:'$D(^TMP("MCAR",$J,MCL)) D GETREC(MCL,RMAR,TV,VV,SP)
|
|---|
| 34 | D EXIT
|
|---|
| 35 | Q
|
|---|
| 36 | SEARCH ; Search for Selected Patient
|
|---|
| 37 | S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
|
|---|
| 38 | D HSUM^GMTSMCMA(DFN,GMTSEND,GMTSBEG,MAX,"",MCTYPE)
|
|---|
| 39 | Q
|
|---|
| 40 | GETREC(MCL,RMAR,TV,VV,SP) ; Return Single Record
|
|---|
| 41 | N MCDATE,MCPROC,MCSUM,MCPSUM,LOOP,LINE,BLINE
|
|---|
| 42 | S (LOOP,BLINE)="",$P(BLINE,"-",80)="-"
|
|---|
| 43 | S MCDATE=$$RETURN("DATE/TIME",MCL)
|
|---|
| 44 | S MCPROC=$$RETURN("PROCEDURE",MCL)
|
|---|
| 45 | S MCSUM=$$RETURN("SUMMARY",MCL)
|
|---|
| 46 | I BRIEF=2,("NBT"[$E(MCSUM,1)),(MCSUM'="") Q
|
|---|
| 47 | S MCPSUM=$$RETURN("PROCEDURE SUMMARY",MCL)
|
|---|
| 48 | D CKP^GMTSUP Q:$D(GMTSQIT) W !,MCDATE,?(TV+SP),MCPROC
|
|---|
| 49 | D CKP^GMTSUP Q:$D(GMTSQIT) W !,BLINE
|
|---|
| 50 | D:MCSUM'="" PRINT(MCSUM,VV,"Summary:",TV,SP)
|
|---|
| 51 | D:MCPSUM'="" PRINT(MCPSUM,VV,"Procedure Summary:",TV,SP)
|
|---|
| 52 | D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
|---|
| 53 | Q:+$G(BRIEF)=0
|
|---|
| 54 | F S LOOP=+$O(^TMP("MCAR",$J,MCL,LOOP)) Q:LOOP=0!$D(GMTSQIT) D REPORT(LOOP,MCL,RMAR,BLINE,TV,VV,SP)
|
|---|
| 55 | Q
|
|---|
| 56 | REPORT(LOOP,MCL,RMAR,BLINE,TV,VV,SP) ; Report for Procedure
|
|---|
| 57 | N LINE,TEMP,HOLD,TITLE,VALUE,UNITS,MLEN,RANGE
|
|---|
| 58 | N TARRAY,VARRY,LARRAY,TMAX,VMAX,MAX,LOOP2
|
|---|
| 59 | S LINE=^TMP("MCAR",$J,MCL,LOOP,1)
|
|---|
| 60 | S TEMP=$P(LINE,U,1),TITLE=$P(TEMP,";",1)_":"
|
|---|
| 61 | S VALUE=$P(LINE,U,3,255),UNITS=$P(LINE,U,2)
|
|---|
| 62 | Q:(VALUE="")&(MCTYPE="C")
|
|---|
| 63 | I $P(TEMP,";",2)="W" D WORD(MCL,LOOP,TITLE,RMAR,TV,VV,SP) Q
|
|---|
| 64 | S VALUE=VALUE_$S(UNITS="":"",1:" "_UNITS)
|
|---|
| 65 | D PRINT(VALUE,VV,TITLE,TV,SP)
|
|---|
| 66 | D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
|---|
| 67 | Q
|
|---|
| 68 | WARP(VALUE,LENGTH,TEMP,MAX) ; Warp a field
|
|---|
| 69 | N DIWL,DIWR,DIWF,X,LOOP3,TEMP1 S LOOP3=""
|
|---|
| 70 | K ^UTILITY($J,"W")
|
|---|
| 71 | S DIWL=0,DIWR=LENGTH,X=VALUE D ^DIWP
|
|---|
| 72 | F MAX=1:1 S LOOP3=+$O(^UTILITY($J,"W",DIWL,LOOP3)) Q:LOOP3=0 D
|
|---|
| 73 | . S TEMP1=^UTILITY($J,"W",DIWL,LOOP3,0)
|
|---|
| 74 | . S:$E(TEMP1,$L(TEMP1))=" " TEMP1=$E(TEMP1,1,$L(TEMP1)-1)
|
|---|
| 75 | . S TEMP(LOOP3)=TEMP1
|
|---|
| 76 | S MAX=MAX-1
|
|---|
| 77 | Q
|
|---|
| 78 | WORD(MCL,LOOP,TITLE,RMAR,TV,VV,SP) ; Display Word Processing
|
|---|
| 79 | N SLOOP,X,DIWR,DIWL,DIWF,TARRAY,TMAX,LOOP3,SPAC
|
|---|
| 80 | D WARP(TITLE,TV,.TARRAY,.TMAX) K ^UTILITY($J,"W") S DIWR=VV,DIWL=0
|
|---|
| 81 | F SLOOP=0:0 S SLOOP=+$O(^TMP("MCAR",$J,MCL,LOOP,SLOOP)) Q:SLOOP=0 D
|
|---|
| 82 | . S X=$P(^TMP("MCAR",$J,MCL,LOOP,SLOOP),U,3) D ^DIWP
|
|---|
| 83 | S SLOOP=0
|
|---|
| 84 | F LOOP3=1:1 S SLOOP=+$O(^UTILITY($J,"W",DIWL,SLOOP)) Q:(SLOOP=0)!($D(GMTSQIT)) D
|
|---|
| 85 | . D CKP^GMTSUP Q:$D(GMTSQIT)
|
|---|
| 86 | . W !,$J($G(TARRAY(LOOP3)),TV),?(TV+SP),^UTILITY($J,"W",DIWL,SLOOP,0)
|
|---|
| 87 | D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
|---|
| 88 | Q
|
|---|
| 89 | CONVERT(TITLE) ; Convert to Mixed Case TEMP = Temp
|
|---|
| 90 | N UPPER,LOWER,TEMP,LOOP,HOLD,HOLD2
|
|---|
| 91 | S UPPER="ABCDEFGHIJKLMNOPQRSTUVWXYZ",LOWER="abcdefghijklmnopqrstuvwxyz"
|
|---|
| 92 | F LOOP=1:1:255 S HOLD=$P(TITLE," ",LOOP) Q:HOLD="" D
|
|---|
| 93 | . S:$D(TEMP) TEMP=TEMP_" "
|
|---|
| 94 | . S HOLD2=$E(HOLD,2,$L(HOLD))
|
|---|
| 95 | . S TEMP=$G(TEMP)_$E(HOLD,1)_$TR(HOLD2,UPPER,LOWER)
|
|---|
| 96 | Q TEMP
|
|---|
| 97 | PRINT(VALUE,VV,TITLE,TV,SP) ; Print a Field and its Value
|
|---|
| 98 | N VMAX,TMAX,TARRAY,VARRAY,SPAC,LOOP2
|
|---|
| 99 | S TITLE=$$CONVERT(TITLE)
|
|---|
| 100 | D WARP(VALUE,VV,.VARRAY,.VMAX)
|
|---|
| 101 | D WARP(TITLE,TV,.TARRAY,.TMAX)
|
|---|
| 102 | S MAX=$S(VMAX<TMAX:TMAX,VMAX>TMAX:VMAX,1:TMAX)
|
|---|
| 103 | S SPAC=TMAX-VMAX S SPAC=$S(SPAC'>0:0,1:SPAC)
|
|---|
| 104 | F LOOP2=1:1:MAX D CKP^GMTSUP Q:$D(GMTSQIT) D
|
|---|
| 105 | . W !,$J($G(TARRAY(LOOP2)),TV),?(TV+SP),$G(VARRAY(LOOP2-SPAC))
|
|---|
| 106 | Q:$D(GMTSQIT)
|
|---|
| 107 | Q
|
|---|
| 108 | RETURN(TYPE,LINE) ; Return key Elements
|
|---|
| 109 | N MCHOLD,HOLD
|
|---|
| 110 | S MCHOLD=+$O(^TMP("MCAR",$J,LINE,"B",TYPE,""))
|
|---|
| 111 | S HOLD=$P($G(^TMP("MCAR",$J,LINE,MCHOLD,1)),U,3)
|
|---|
| 112 | K ^TMP("MCAR",$J,LINE,"B",TYPE,LINE)
|
|---|
| 113 | K ^TMP("MCAR",$J,LINE,MCHOLD,1)
|
|---|
| 114 | Q HOLD
|
|---|
| 115 | EXIT ; Clean up and Quit
|
|---|
| 116 | K PR,OT,DA,MCARPPS,MCI,MCJ,R,MCL,S1,S2,S4,S5,S6,LL,LL1,MAX,VA
|
|---|
| 117 | K ^TMP("MCAR",$J),K,N,MCARDT,MCARNM,MCARPROC,M,RMAR
|
|---|
| 118 | Q
|
|---|
