source: WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDHL7U1.m@ 1200

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1MDHL7U1 ; HOIFO/WAA -Routine utilities for CP PROCESSING OBX ; 7/26/00
2 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
3 ;
4PATHCHK(X,Y) ; Check the OBX to see if it is a path then set the path.
5 ;
6 S Y=0
7 I $S($P(X,"|",3)="ST":0,$P(X,"|",3)="TX":0,1:1) Q
8 I X["//" S X=$TR(X,"/","\")
9 I X["\E\" D
10 . N Y,Z
11 . S Z=""
12 . F I=1:1:$L(X) S Y=$E(X,I) D:Y="\" S Z=Z_Y
13 . . I $E(X,I+1)="E",$E(X,I+2)="\" S I=I+2
14 . . Q
15 . S X=Z
16 . Q
17 I X'["\\" Q
18 S Y("FPATH")=$P(X,"|",6)
19 I Y("FPATH")'["\\" S Y("FPATH")=$P(X,"|",4)
20 S Y("FPATH")="\\"_$P(Y("FPATH"),"\\",2)
21 S Y("FILE")=$P(Y("FPATH"),"\",($L(Y("FPATH"),"\")))
22 I $P(Y("FILE"),".",2)="" Q
23 S Y("PATH")=$P(Y("FPATH"),"\",1,($L(Y("FPATH"),"\")-1))
24 S Y=1
25 Q
26REX(DA) ; Reindex the 703.1 entry
27 Q:'$D(^MDD(703.1,DA,0))
28 S DIK="^MDD(703.1," D IX1^DIK
29 Q
30UNC ;;PROCESS UNC;.301
31 N CNT
32 S CNT=0
33 F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
34 . N LINE,PATH,DA,DIK
35 . S LINE=^TMP($J,"MDHL7A",CNT) Q:LINE=""
36 . I $P(LINE,"|",1)'="OBX" Q
37 . D PATHCHK(LINE,.PATH)
38 . Q:'PATH
39 . S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
40 . Q:'MDDZ
41 . S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
42 . S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
43 . Q
44 Q
45URL ;;PROCESS URL;.303
46 N CNT
47 S CNT=0
48 F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
49 . N LINE,PATH
50 . S LINE=^TMP($J,"MDHL7A",CNT) Q:LINE=""
51 . I $P(LINE,"|",1)'="OBX" Q
52 . D PATHCHK(LINE,.PATH)
53 . I PATH S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
54 . Q:'MDDZ
55 . S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
56 . S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
57 . Q
58 Q
59 Q
60DDL ;;PROCESS DLL;.304
61 N CNT
62 S CNT=0
63 F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
64 . N LINE,PATH
65 . S LINE=^TMP($J,"MDHL7A",CNT) Q:LINE=""
66 . I $P(LINE,"|",1)'="OBX" Q
67 . D PATHCHK(LINE,.PATH)
68 . I PATH S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
69 . Q:'MDDZ
70 . S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
71 . S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
72 . Q
73 Q
74 Q
75UUEN ;;PROCESS UUENCODE;.305
76 N CNT,CNT2,MDDZ
77 S (CNT,CNT2)=0
78 S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
79 Q:'MDDZ
80 S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
81 S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=$G(FTYPE,"")
82 F S CNT=$O(^TMP($J,"MDHL7","UUENCODE",CNT)) Q:CNT<1 D
83 . N LINE
84 . S LINE=^TMP($J,"MDHL7","UUENCODE",CNT)
85 . S ^MDD(703.1,MDIEN,.1,MDDZ,.2,CNT,0)=LINE
86 . S CNT2=CNT
87 . Q
88 D NOW^%DTC
89 S ^MDD(703.1,MDIEN,.1,MDDZ,.2,0)="^^"_CNT2_"^"_CNT2_"^"_$P(%,".")_"^"
90 Q
91XML ;;PROCESS XML;.306
92 N CNT
93 S CNT=0
94 F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
95 . N LINE,PATH
96 . S LINE=^TMP($J,"MDHL7A",CNT) Q:LINE=""
97 . I $P(LINE,"|",1)'="OBX" Q
98 . D PATHCHK(LINE,.PATH)
99 . I PATH S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
100 . Q:'MDDZ
101 . S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
102 . S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
103 . Q
104 Q
105 Q
106XMS ;;PROCESS XMS;.307
107 N CNT
108 S CNT=0
109 F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
110 . N LINE,PATH
111 . S LINE=^TMP($J,"MDHL7A",CNT) Q:LINE=""
112 . I $P(LINE,"|",1)'="OBX" Q
113 . D PATHCHK(LINE,.PATH)
114 . I PATH S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
115 . Q:'MDDZ
116 . S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
117 . S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
118 . Q
119 Q
Note: See TracBrowser for help on using the repository browser.