| 1 | MCAR7E ; HIRMFO/REL-Olympus/CMore Endoscopy ;7/24/00 11:16
|
|---|
| 2 | ;;2.3;Medicine;**24**;09/13/1996
|
|---|
| 3 | OBX ; Process OBX
|
|---|
| 4 | S X=$G(MSG(NUM)) I $E(X,1,3)'="OBX" S ERRTX="OBX not found when expected" G ^MCAR7X
|
|---|
| 5 | S SEG("OBX")=X
|
|---|
| 6 | UPDATE ; Update File
|
|---|
| 7 | S FIL=699 D PROC^MCAR7A ; Set Procedure entry
|
|---|
| 8 | ; Process Note
|
|---|
| 9 | S LN=0,J=0,^MCAR(699,DA,33,0)="^^0^0^"_DT_"^"
|
|---|
| 10 | I MCAPP="OLYMPUS" S SEP="^" G OLY
|
|---|
| 11 | I MCAPP="PENTAX" S SEP="^" G PEN
|
|---|
| 12 | I MCAPP="CMore" S SEP="~"
|
|---|
| 13 | CMO ; Process CMore
|
|---|
| 14 | S LINE=$P(MSG(NUM),"|",6)
|
|---|
| 15 | U1 I LINE[SEP D C1 G U1
|
|---|
| 16 | S J=J+1 I $G(MSG(NUM,J))="" D:LINE'="" C1 G U2
|
|---|
| 17 | S LINE=LINE_MSG(NUM,J) S:LINE["|" LINE=$P(LINE,"|",1) G U1
|
|---|
| 18 | C1 S LN=LN+1,%=$P(LINE,SEP,1),LINE=$P(LINE,SEP,2,999)
|
|---|
| 19 | S:%="" %=" " S ^MCAR(699,DA,33,LN,0)=% Q
|
|---|
| 20 | OLY ; Process Olympus
|
|---|
| 21 | F S LINE=$P($G(MSG(NUM)),"|",6) Q:LINE="" D U3 S NUM=NUM+1
|
|---|
| 22 | G U2
|
|---|
| 23 | PEN ; Process Pentax data
|
|---|
| 24 | N LN
|
|---|
| 25 | S LN=0
|
|---|
| 26 | F S LINE=$P($G(MSG(NUM)),"|",6) Q:'$D(MSG(NUM)) D S NUM=NUM+1
|
|---|
| 27 | .S LN=LN+1
|
|---|
| 28 | .S ^MCAR(699,DA,33,LN,0)=LINE
|
|---|
| 29 | .Q
|
|---|
| 30 | G U2
|
|---|
| 31 | U2 S $P(^MCAR(699,DA,33,0),"^",3,4)=(LN_"^"_LN)
|
|---|
| 32 | S:EXAM="" EXAM="Endoscopy" S PIEN=$O(^MCAR(697.2,"B",EXAM,0))
|
|---|
| 33 | I PIEN="" S:EXAM2'="" PIEN=$O(^MCAR(697.2,"B",EXAM2,0))
|
|---|
| 34 | I PIEN="" D
|
|---|
| 35 | .K DIC S (DIC,DLAYGO)=697.2,DIC(0)="L",X=$C(34)_EXAM_$C(34)
|
|---|
| 36 | .S DIC("DR")="1///MCAR(699;1.1///.02;3///G;4///ENDO;5///MCARGP;6///GI;7///"_EXAM_";11///1;12///MCKEYGI;13///1;15///1;1001///P"
|
|---|
| 37 | .D ^DIC S PIEN=+Y K DIC,DLAYGO Q
|
|---|
| 38 | S $P(^MCAR(699,DA,0),"^",12)=PIEN
|
|---|
| 39 | ; Re-index record
|
|---|
| 40 | S DIK="^MCAR(699," D IX1^DIK
|
|---|
| 41 | D GENACK^MCAR7X
|
|---|
| 42 | Q
|
|---|
| 43 | U3 ; Add a line
|
|---|
| 44 | S J=0 D NJ
|
|---|
| 45 | U4 S %=$L(LINE)+1 I %<80 G:NEXT="" ST D G U4
|
|---|
| 46 | .S LINE=LINE_$E(NEXT,1,125),NEXT=$E(NEXT,126,999) D:NEXT="" NJ
|
|---|
| 47 | .Q
|
|---|
| 48 | F %=79:-1:1 Q:$E(LINE,%)=" "
|
|---|
| 49 | D ST G U4
|
|---|
| 50 | NJ S J=J+1,NEXT=$P($G(MSG(NUM,J)),"|",1) Q
|
|---|
| 51 | ST S LN=LN+1,^MCAR(699,DA,33,LN,0)=$E(LINE,1,%-1),LINE=$E(LINE,%+1,999) Q
|
|---|
