| [613] | 1 | MCAR7P1 ; HIRMFO/REL-Sensormedics Pulmonary ;3/3/00 09:55
|
|---|
| 2 | ;;2.3;Medicine;**24**;09/13/1996
|
|---|
| 3 | S TCNT=0
|
|---|
| 4 | OBX ; Process OBX
|
|---|
| 5 | S X=$G(MSG(NUM)) G:X="" UPDATE I $E(X,1,3)'="OBX" S ERRTX="OBX not found when expected" G ^MCAR7X
|
|---|
| 6 | S SEG("OBX")=X
|
|---|
| 7 | S STYP=$P(X,"|",3) I STYP="TX" G IMP
|
|---|
| 8 | S ID=$P(X,"|",5),CODE=$P(X,"|",4),VAL=$P(X,"|",6),UNITS=$P(X,"|",7) I CODE["^" S CODE=$P(CODE,"^",1)
|
|---|
| 9 | I CODE=""!(VAL="") G NEXT
|
|---|
| 10 | S CODE=$$UP^XLFSTR(CODE)
|
|---|
| 11 | I $E(CODE,1,3)'?2.3U G NEXT
|
|---|
| 12 | S STR=$P($T(@$E(CODE,1,3)),";;",2) I STR="" G NEXT
|
|---|
| 13 | S S=$P(STR,"^",2),P=$P(STR,"^",3),EXE=$P(STR,"^",4) I EXE'="" X EXE I VAL="" G NEXT
|
|---|
| 14 | I S="P" S $P(SET(S,+P),"^",$P(P,";",2))=VAL G NEXT
|
|---|
| 15 | I ID<4 S $P(SET(S,ID-1),"^",$P(P,";",2))=VAL I S="V",$P(CODE," ",1)="FRC" S VAL=$P($P(X,"|",4)," ",2) I VAL'="" S $P(SET(S,ID-1),"^",1)=$S(VAL["Dil":"N",1:"B")
|
|---|
| 16 | NEXT S NUM=NUM+1 G OBX
|
|---|
| 17 | IMP ; Get Impression
|
|---|
| 18 | S NUM=NUM+1,CODE=$P(X,"|",4)
|
|---|
| 19 | I CODE["Interp" S ICNT=ICNT+1,IMP("I",ICNT)=$P(X,"|",6) G OBX
|
|---|
| 20 | I CODE["Tech" S TCNT=TCNT+1,IMP("T",TCNT)=$P(X,"|",6) G OBX
|
|---|
| 21 | G OBX
|
|---|
| 22 | UPDATE ; Update File
|
|---|
| 23 | S FIL=700 D PROC^MCAR7A ; Set Procedure Entry
|
|---|
| 24 | 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
|
|---|
| 25 | F ID="F","V" I $D(SET(ID)) D U1
|
|---|
| 26 | I ICNT F P=1:1:ICNT S ^MCAR(700,DA,25,P,0)=IMP("I",P)
|
|---|
| 27 | I ICNT S ^MCAR(700,DA,25,0)="^^"_ICNT_"^"_ICNT_"^"_DT
|
|---|
| 28 | I TCNT F P=1:1:TCNT S ^MCAR(700,DA,16,P,0)=IMP("T",P)
|
|---|
| 29 | I TCNT S ^MCAR(700,DA,16,0)="^^"_TCNT_"^"_TCNT_"^"_DT
|
|---|
| 30 | S DIK="^MCAR(700," D IX1^DIK
|
|---|
| 31 | D GENACK^MCAR7X
|
|---|
| 32 | Q
|
|---|
| 33 | U1 ; Set Study values
|
|---|
| 34 | S S=$S(ID="F":4,ID="V":3,1:"") Q:'S
|
|---|
| 35 | I ID="F" F P=1,2 I $D(SET(ID,P)) S $P(SET(ID,P),"^",1)=$S(P=1:"S",1:"B")
|
|---|
| 36 | 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"
|
|---|
| 37 | I '$D(^MCAR(700,DA,S,0)) S ^MCAR(700,DA,S,0)="^"_$S(S=3:"700.017SA",1:"700.018SA")_"^0^0"
|
|---|
| 38 | 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
|
|---|
| 39 | S P=$O(SET(ID,""),-1),$P(^MCAR(700,DA,S,0),"^",3,4)=(P_"^"_P)
|
|---|
| 40 | Q
|
|---|
| 41 | VARS ;;
|
|---|
| 42 | FVC ;;FVC^F^0;2
|
|---|
| 43 | FEV ;;FEV1^F^0;3
|
|---|
| 44 | FEF ;;FEF25-75%^F^0;5
|
|---|
| 45 | PEF ;;PEF^F^0;4
|
|---|
| 46 | MVV ;;MVV^F^0;7
|
|---|
| 47 | TLC ;;TLC^V^0;2
|
|---|
| 48 | RV ;;RV^V^0;5
|
|---|
| 49 | FRC ;;FRC^V^0;4
|
|---|
| 50 | DLC ;;DLCO^P^5;1^I ID'=2 S VAL=""
|
|---|
| 51 | HEI ;;HEIGHT^P^0;4
|
|---|
| 52 | WEI ;;WEIGHT^P^0;5
|
|---|
| 53 | SMO ;;SMOKER^P^0;8^S VAL=$E($G(VAL),1)
|
|---|
| 54 | TEM ;;TEMP^P^0;12
|
|---|
| 55 | PBA ;;PBAR^P^0;7
|
|---|
| 56 | VC ;;VC^V^0;3
|
|---|
