| 1 | GMTSMCPZ ; SLC/SBW,KER - Medicine 2.0 HS Component ; 11/02/1998
|
|---|
| 2 | ;;2.7;Health Summary;**28**;Oct 20, 1995
|
|---|
| 3 | K WH,%DT,X,Y Q
|
|---|
| 4 | BEG ;SEARCH FOR SELECTED PATIENT IN CARDIOLOGY FILE
|
|---|
| 5 | D KVAR^VADPT
|
|---|
| 6 | I $D(GMTSNDM),(GMTSNDM>0) S MAX=GMTSNDM
|
|---|
| 7 | E S MAX=50
|
|---|
| 8 | LOC ;LOCATE PROCEDURES FROM "AC" X-REF
|
|---|
| 9 | I '$D(^MCAR(690,"AC",DFN)) G EXIT
|
|---|
| 10 | K ^TMP("MCAR",$J) S S4=GMTS1-.0001 F M=1:1:MAX S S4=$O(^MCAR(690,"AC",DFN,S4)) Q:S4=""!(S4>GMTS2) D LOCFIL
|
|---|
| 11 | G PR0
|
|---|
| 12 | LOCFIL G LOCFIL1:$D(S5) S S5="" F K=1:1 S S5=$O(^MCAR(690,"AC",DFN,S4,S5)) Q:S5="" D LOCFIL1
|
|---|
| 13 | K S5 Q
|
|---|
| 14 | LOCFIL1 ; Set S5 to the PROCEDURE LOCATION (^MCAR(697.2,Y,0))
|
|---|
| 15 | S S6="" F L=1:1 S S6=$O(^MCAR(690,"AC",DFN,S4,S5,S6)) Q:S6="" D CONT
|
|---|
| 16 | Q
|
|---|
| 17 | CONT I S5[699 S (LL,LL1)=$P(^MCAR(699,S6,0),U,12),LL=$P(^MCAR(697.2,LL,0),U) G CONT1:'$D(PE) Q:PE'=LL G CONT1
|
|---|
| 18 | I S5[694 S (LL,LL1)=$P(^MCAR(694,S6,0),U,3),LL=$P(^MCAR(697.2,LL,0),U) G CONT1:'$D(PE) Q:PE'=LL G CONT1
|
|---|
| 19 | S (LL,LL1)=$O(^MCAR(697.2,"C",S5,0)),LL=$P(^MCAR(697.2,LL,0),U,1)
|
|---|
| 20 | CONT1 S MCARSUM="",MCARFILE=U_S5_","_S6_",.2)" S:$D(@MCARFILE) MCARSUM=$P(@MCARFILE,U,1)
|
|---|
| 21 | K MCARFILE S S1=S4,S2=LL
|
|---|
| 22 | S ^TMP("MCAR",$J,S1,S2)=MCARSUM_U_S6_U_$P(^MCAR(697.2,LL1,0),U,5,7) K MCARSUM Q
|
|---|
| 23 | PR0 I '$D(^TMP("MCAR",$J)) G EXIT
|
|---|
| 24 | S I="",L=0
|
|---|
| 25 | PR1 S I=$O(^TMP("MCAR",$J,I)) G PR1:I="OT" I I="" G EXIT
|
|---|
| 26 | S J=""
|
|---|
| 27 | PR2 S J=$O(^TMP("MCAR",$J,I,J)) G PR1:J="" S MCARDT=I,MCARPROC=J,PR=^(J)
|
|---|
| 28 | S DA=$P(PR,U,2),K=$P(PR,U)
|
|---|
| 29 | S K=$S(K="N"!(K="L"):"NORMAL",K="A":"ABNORMAL",K="B":"BORDERLINE",K="T":"TECHNICALLY UNSATISFACTORY",K="ND":"NON-DIAGNOSTIC",1:"")
|
|---|
| 30 | S Y=9999999.9999-MCARDT X ^DD("DD") D DFIX,CKP^GMTSUP Q:$D(GMTSQIT) W Y,?23,MCARPROC,?62,K,!
|
|---|
| 31 | S ^TMP("MCAR",$J,"OT",L)=MCARPROC_U_DA_U_$P(PR,U,3,5)
|
|---|
| 32 | G PR2
|
|---|
| 33 | DFIX ;
|
|---|
| 34 | S %DT="T",X=Y D ^%DT S X=Y D REGDTM4^GMTSU S Y=X Q
|
|---|
| 35 | EXIT ;
|
|---|
| 36 | K PR,OT,DA,MCARPPS,I,J,R,L,S1,S2,S4,S5,S6,LL,LL1,MAX,VA
|
|---|
| 37 | K ^TMP("MCAR",$J),K,N,MCARDT,MCARNM,MCARPROC,M Q
|
|---|
