source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCAR7M1.m@ 1361

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1MCAR7M1 ; HIRMFO/REL-Muse EKG ;6/7/00 10:11
2 ;;2.3;Medicine;**24**;09/13/1996
3 S EXAM=$P($P(SEG("OBR"),"|",5),"^",1) S:EXAM="" EXAM=99999
4 S X=$T(@EXAM),FIL=$P(X,";",4),SUB=$P(X,";",5) I FIL=""!(SUB="") S ERRTX="Unknown Exam Type" G ^MCAR7X
5 F P=1:1 S VAL=$T(VARS+P) Q:VAL="" S SET($P(VAL,";",3))=$P(VAL,";",4,5)
6 S X=$P($P(SEG("OBR"),"|",33),"^",1)
7 I +X,$$GET1^DIQ(200,X,.01,"I")'="" S $P(SET("Interpreter"),";",3)=X
8OBX ; Process OBX
9 S X=$G(MSG(NUM)) G:X="" UPDATE I $E(X,1,3)'="OBX" S ERRTX="OBX not found when expected" G ^MCAR7X
10 S SEG("OBX")=X
11 S STYP=$P(X,"|",3) I STYP'="ST" G IMP
12 S CODE=$P(X,"|",4),VAL=$P(X,"|",6),UNITS=$P(X,"|",7) I CODE["^" S CODE=$P(CODE,"^",2)
13 I CODE=""!(VAL="") G NEXT
14 I $D(SET(CODE)) S $P(SET(CODE),";",3)=VAL
15NEXT S NUM=NUM+1 G OBX
16IMP ; Get Impression
17 S NUM=NUM+1,VAL=$P(X,"|",6) I STYP="CE" S VAL=$P(VAL,"^",2)
18 S ICNT=ICNT+1,IMP(ICNT)=VAL G OBX
19UPDATE ; Update File
20 D PROC^MCAR7A ; Set Procedure Entry
21 I EXAM=93000 S ID="" F S ID=$O(SET(ID)) Q:ID="" S P=$P(SET(ID),";",1) I P'="" S K=$P(SET(ID),";",2) I K'="" S VAL=$P(SET(ID),";",3) S:VAL'="" $P(^MCAR(FIL,DA,P),"^",K)=VAL
22 I $D(IMP) F P=1:1:ICNT S ^MCAR(FIL,DA,SUB,P,0)=IMP(P)
23 I S ^MCAR(FIL,DA,SUB,0)="^^"_ICNT_"^"_ICNT_"^"_DT
24 S DIK="^MCAR("_FIL_"," D IX1^DIK
25 D GENACK^MCAR7X
26 Q
2793000 ;;EKG;691.5;9
2893040 ;;Pacemaker;698.3;10
2993015 ;;Exercise;691.7;6
3093266 ;;Holter;691.6;7
3193529 ;;Cath;691.1;43
3293307 ;;Echo;691;3
3393619 ;;Electrophysiology;691.8;12
34VARS ;;
35 ;;Interpreter;0;13
36 ;;Systolic Blood Pressure;4;2
37 ;;Diastolic Blood Pressure;4;1
38 ;;Ventricular Rate;0;4
39 ;;Atrial Rate;
40 ;;P-R Interval;0;5
41 ;;QRS Duration;0;6
42 ;;QT;0;7
43 ;;QTc;0;8
44 ;;P Axis;0;9
45 ;;QRS Axis;
46 ;;T Axis;0;11
Note: See TracBrowser for help on using the repository browser.