source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCAR7P2.m@ 1211

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1MCAR7P2 ; HIRMFO/REL-MedGraphics Pulmonary ;3/3/00 09:57
2 ;;2.3;Medicine;**24**;09/13/1996
3OBX ; Process OBX
4 S X=$G(MSG(NUM)) G:X="" UPDATE I $E(X,1,3)'="OBX" S ERRTX="OBX not found when expected" G ^MCAR7X
5 S SEG("OBX")=X
6 S STYP=$P(X,"|",3) I STYP="TX" G IMP
7 S ID=$P(X,"|",5),CODE=$P(X,"|",4),VAL=$P(X,"|",6),UNITS=$P(X,"|",7) I CODE["^" S CODE=$P(CODE,"^",1)
8 I CODE=""!(VAL="") G NEXT
9 I $E(CODE,1,3)'?2.3U G NEXT
10 S STR=$P($T(@$E(CODE,1,3)),";;",2) I STR="" G NEXT
11 S S=$P(STR,"^",2),P=$P(STR,"^",3),EXE=$P(STR,"^",4) I EXE'="" X EXE
12 I S="P" S $P(SET(S,+P),"^",$P(P,";",2))=VAL G NEXT
13 I ID>1 S $P(SET(S,ID-1),"^",$P(P,";",2))=VAL
14NEXT S NUM=NUM+1 G OBX
15IMP ; Get Impression
16 S NUM=NUM+1 S:$P(X,"|",4)[("&IMP") ICNT=ICNT+1,IMP(ICNT)=$P(X,"|",6) G OBX
17 Q
18UPDATE ; Update File
19 S FIL=700 D PROC^MCAR7A ; Set Procedure Entry
20 S P="" F S P=$O(SET("P",P)) Q:P="" F K=1:1:$L(SET("P",P),"^") S VAL=$P(SET("P",P),"^",K) I VAL'="" S $P(^MCAR(700,DA,P),"^",K)=VAL
21 F ID="F","V" I $D(SET(ID)) D U1
22 I $D(IMP) F P=1:1:ICNT S ^MCAR(700,DA,25,P,0)=IMP(P)
23 I S ^MCAR(700,DA,25,0)="^^"_ICNT_"^"_ICNT_"^"_DT
24 S DIK="^MCAR(700," D IX1^DIK
25 D GENACK^MCAR7X
26 Q
27U1 ; Set Study values
28 S S=$S(ID="F":4,ID="V":3,1:"") Q:'S
29 I ID="F" F P=1,2 I $D(SET(ID,P)) S $P(SET(ID,P),"^",1)=$S(P=1:"S",1:"B")
30 I ID="V" F P=1,2 I $D(SET(ID,P)) I $P(SET(ID,P),"^",1)="" S $P(SET(ID,P),"^",1)="B"
31 I '$D(^MCAR(700,DA,S,0)) S ^MCAR(700,DA,S,0)="^"_$S(S=3:"700.017SA",1:"700.018SA")_"^0^0"
32 S P=0 F S P=$O(SET(ID,P)) Q:P="" F K=1:1:$L(SET(ID,P),"^") S VAL=$P(SET(ID,P),"^",K) I VAL'="" S $P(^MCAR(700,DA,S,P,0),"^",K)=VAL
33 S P=$O(SET(ID,""),-1),$P(^MCAR(700,DA,S,0),"^",3,4)=(P_"^"_P)
34 Q
35VARS ;;
36FVC ;;FVC^F^0;2
37FEV ;;FEV1^F^0;3
38FEF ;;FEF25-75%^F^0;5
39PEF ;;PEF^F^0;4
40MVV ;;MVV^F^0;7
41TLC ;;TLC^V^0;2
42RV ;;RV^V^0;5
43FRC ;;FRC^V^0;4
44DLC ;;DLCO^P^5;1
45HEI ;;HEIGHT^P^0;4
46WEI ;;WEIGHT^P^0;5
47SMO ;;SMOKER^P^0;8^S VAL=$E($G(VAL),1)
48TEM ;;TEMP^P^0;12
49PBA ;;PBAR^P^0;7
50SVC ;;VC^V^0;3
Note: See TracBrowser for help on using the repository browser.