source: FOIAVistA/tag/r/MEDICINE-MC/MCAR7E.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1MCAR7E ; HIRMFO/REL-Olympus/CMore Endoscopy ;7/24/00 11:16
2 ;;2.3;Medicine;**24**;09/13/1996
3OBX ; 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
6UPDATE ; 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="~"
13CMO ; Process CMore
14 S LINE=$P(MSG(NUM),"|",6)
15U1 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
18C1 S LN=LN+1,%=$P(LINE,SEP,1),LINE=$P(LINE,SEP,2,999)
19 S:%="" %=" " S ^MCAR(699,DA,33,LN,0)=% Q
20OLY ; Process Olympus
21 F S LINE=$P($G(MSG(NUM)),"|",6) Q:LINE="" D U3 S NUM=NUM+1
22 G U2
23PEN ; 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
31U2 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
43U3 ; Add a line
44 S J=0 D NJ
45U4 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
50NJ S J=J+1,NEXT=$P($G(MSG(NUM,J)),"|",1) Q
51ST S LN=LN+1,^MCAR(699,DA,33,LN,0)=$E(LINE,1,%-1),LINE=$E(LINE,%+1,999) Q
Note: See TracBrowser for help on using the repository browser.