MDHL7U1 ; HOIFO/WAA -Routine utilities for CP PROCESSING OBX ; 7/26/00
;;1.0;CLINICAL PROCEDURES;**11**;Apr 01, 2004;Build 67
;
PATHCHK(X,Y) ; Check the OBX to see if it is a path then set the path.
;
S Y=0
; Add the OBX report type of RP Reference Pointer
I $S($P(X,"|",3)="ST":0,$P(X,"|",3)="TX":0,$P(X,"|",3)="RP":0,1:1) Q
I X["//" S X=$TR(X,"/","\")
I X["\E\" D
. N Y,Z
. S Z=""
. F I=1:1:$L(X) S Y=$E(X,I) D:Y="\" S Z=Z_Y
. . I $E(X,I+1)="E",$E(X,I+2)="\" S I=I+2
. . Q
. S X=Z
. Q
I X'["\\" Q
S Y("FPATH")=$P(X,"|",6)
I Y("FPATH")'["\\" S Y("FPATH")=$P(X,"|",4)
S Y("FPATH")="\\"_$P(Y("FPATH"),"\\",2)
S Y("FILE")=$P(Y("FPATH"),"\",($L(Y("FPATH"),"\")))
I $P(Y("FILE"),".",2)="" Q
S Y("PATH")=$P(Y("FPATH"),"\",1,($L(Y("FPATH"),"\")-1))
S Y=1
Q
REX(DA) ; Reindex the 703.1 entry
Q:'$D(^MDD(703.1,DA,0))
S DIK="^MDD(703.1," D IX1^DIK
Q
UNC ;;PROCESS UNC;.301
N CNT
S CNT=0
F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
. N LINE,PATH,DA,DIK
. S LINE=^TMP($J,"MDHL7A",CNT) Q:LINE=""
. I $P(LINE,"|",1)'="OBX" Q
. D PATHCHK(LINE,.PATH)
. Q:'PATH
. S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
. Q:'MDDZ
. S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
. S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
. Q
Q
URL ;;PROCESS URL;.303
N CNT
S CNT=0
F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
. N LINE,PATH
. S LINE=^TMP($J,"MDHL7A",CNT) Q:LINE=""
. I $P(LINE,"|",1)'="OBX" Q
. D PATHCHK(LINE,.PATH)
. I PATH S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
. Q:'MDDZ
. S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
. S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
. Q
Q
DDL ;;PROCESS DLL;.304
N CNT
S CNT=0
F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
. N LINE,PATH
. S LINE=^TMP($J,"MDHL7A",CNT) Q:LINE=""
. I $P(LINE,"|",1)'="OBX" Q
. D PATHCHK(LINE,.PATH)
. I PATH S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
. Q:'MDDZ
. S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
. S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
. Q
Q
UUEN ;;PROCESS UUENCODE;.305
N CNT,CNT2,MDDZ
S (CNT,CNT2)=0
S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
Q:'MDDZ
S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=$G(FTYPE,"")
F S CNT=$O(^TMP($J,"MDHL7","UUENCODE",CNT)) Q:CNT<1 D
. N LINE
. S LINE=^TMP($J,"MDHL7","UUENCODE",CNT)
. S ^MDD(703.1,MDIEN,.1,MDDZ,.2,CNT,0)=LINE
. S CNT2=CNT
. Q
D NOW^%DTC
S ^MDD(703.1,MDIEN,.1,MDDZ,.2,0)="^^"_CNT2_"^"_CNT2_"^"_$P(%,".")_"^"
Q
XML ;;PROCESS XML;.306
N CNT
S CNT=0
F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
. N LINE,PATH
. S LINE=^TMP($J,"MDHL7A",CNT) Q:LINE=""
. I $P(LINE,"|",1)'="OBX" Q
. D PATHCHK(LINE,.PATH)
. I PATH S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
. Q:'MDDZ
. S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
. S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
. Q
Q
XMS ;;PROCESS XMS;.307
N CNT
S CNT=0
F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
. N LINE,PATH
. S LINE=^TMP($J,"MDHL7A",CNT) Q:LINE=""
. I $P(LINE,"|",1)'="OBX" Q
. D PATHCHK(LINE,.PATH)
. I PATH S MDDZ=$$UPDATE^MDHL7U(MDIEN) ; Create the entry in the multi.
. Q:'MDDZ
. S ^MDD(703.1,MDIEN,.1,MDDZ,0)=$P(MDATT(PROC),";",6)
. S ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDHL7U1 3449 printed Nov 22, 2024@16:53:08 Page 2
MDHL7U1 ; HOIFO/WAA -Routine utilities for CP PROCESSING OBX ; 7/26/00
+1 ;;1.0;CLINICAL PROCEDURES;**11**;Apr 01, 2004;Build 67
+2 ;
PATHCHK(X,Y) ; Check the OBX to see if it is a path then set the path.
+1 ;
+2 SET Y=0
+3 ; Add the OBX report type of RP Reference Pointer
+4 IF $SELECT($PIECE(X,"|",3)="ST":0,$PIECE(X,"|",3)="TX":0,$PIECE(X,"|",3)="RP":0,1:1)
QUIT
+5 IF X["//"
SET X=$TRANSLATE(X,"/","\")
+6 IF X["\E\"
Begin DoDot:1
+7 NEW Y,Z
+8 SET Z=""
+9 FOR I=1:1:$LENGTH(X)
SET Y=$EXTRACT(X,I)
if Y="\"
Begin DoDot:2
+10 IF $EXTRACT(X,I+1)="E"
IF $EXTRACT(X,I+2)="\"
SET I=I+2
+11 QUIT
End DoDot:2
SET Z=Z_Y
+12 SET X=Z
+13 QUIT
End DoDot:1
+14 IF X'["\\"
QUIT
+15 SET Y("FPATH")=$PIECE(X,"|",6)
+16 IF Y("FPATH")'["\\"
SET Y("FPATH")=$PIECE(X,"|",4)
+17 SET Y("FPATH")="\\"_$PIECE(Y("FPATH"),"\\",2)
+18 SET Y("FILE")=$PIECE(Y("FPATH"),"\",($LENGTH(Y("FPATH"),"\")))
+19 IF $PIECE(Y("FILE"),".",2)=""
QUIT
+20 SET Y("PATH")=$PIECE(Y("FPATH"),"\",1,($LENGTH(Y("FPATH"),"\")-1))
+21 SET Y=1
+22 QUIT
REX(DA) ; Reindex the 703.1 entry
+1 if '$DATA(^MDD(703.1,DA,0))
QUIT
+2 SET DIK="^MDD(703.1,"
DO IX1^DIK
+3 QUIT
UNC ;;PROCESS UNC;.301
+1 NEW CNT
+2 SET CNT=0
+3 FOR
SET CNT=$ORDER(^TMP($JOB,"MDHL7A",CNT))
if CNT<1
QUIT
Begin DoDot:1
+4 NEW LINE,PATH,DA,DIK
+5 SET LINE=^TMP($JOB,"MDHL7A",CNT)
if LINE=""
QUIT
+6 IF $PIECE(LINE,"|",1)'="OBX"
QUIT
+7 DO PATHCHK(LINE,.PATH)
+8 if 'PATH
QUIT
+9 ; Create the entry in the multi.
SET MDDZ=$$UPDATE^MDHL7U(MDIEN)
+10 if 'MDDZ
QUIT
+11 SET ^MDD(703.1,MDIEN,.1,MDDZ,0)=$PIECE(MDATT(PROC),";",6)
+12 SET ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
+13 QUIT
End DoDot:1
+14 QUIT
URL ;;PROCESS URL;.303
+1 NEW CNT
+2 SET CNT=0
+3 FOR
SET CNT=$ORDER(^TMP($JOB,"MDHL7A",CNT))
if CNT<1
QUIT
Begin DoDot:1
+4 NEW LINE,PATH
+5 SET LINE=^TMP($JOB,"MDHL7A",CNT)
if LINE=""
QUIT
+6 IF $PIECE(LINE,"|",1)'="OBX"
QUIT
+7 DO PATHCHK(LINE,.PATH)
+8 ; Create the entry in the multi.
IF PATH
SET MDDZ=$$UPDATE^MDHL7U(MDIEN)
+9 if 'MDDZ
QUIT
+10 SET ^MDD(703.1,MDIEN,.1,MDDZ,0)=$PIECE(MDATT(PROC),";",6)
+11 SET ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
+12 QUIT
End DoDot:1
+13 QUIT
DDL ;;PROCESS DLL;.304
+1 NEW CNT
+2 SET CNT=0
+3 FOR
SET CNT=$ORDER(^TMP($JOB,"MDHL7A",CNT))
if CNT<1
QUIT
Begin DoDot:1
+4 NEW LINE,PATH
+5 SET LINE=^TMP($JOB,"MDHL7A",CNT)
if LINE=""
QUIT
+6 IF $PIECE(LINE,"|",1)'="OBX"
QUIT
+7 DO PATHCHK(LINE,.PATH)
+8 ; Create the entry in the multi.
IF PATH
SET MDDZ=$$UPDATE^MDHL7U(MDIEN)
+9 if 'MDDZ
QUIT
+10 SET ^MDD(703.1,MDIEN,.1,MDDZ,0)=$PIECE(MDATT(PROC),";",6)
+11 SET ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
+12 QUIT
End DoDot:1
+13 QUIT
UUEN ;;PROCESS UUENCODE;.305
+1 NEW CNT,CNT2,MDDZ
+2 SET (CNT,CNT2)=0
+3 ; Create the entry in the multi.
SET MDDZ=$$UPDATE^MDHL7U(MDIEN)
+4 if 'MDDZ
QUIT
+5 SET ^MDD(703.1,MDIEN,.1,MDDZ,0)=$PIECE(MDATT(PROC),";",6)
+6 SET ^MDD(703.1,MDIEN,.1,MDDZ,.1)=$GET(FTYPE,"")
+7 FOR
SET CNT=$ORDER(^TMP($JOB,"MDHL7","UUENCODE",CNT))
if CNT<1
QUIT
Begin DoDot:1
+8 NEW LINE
+9 SET LINE=^TMP($JOB,"MDHL7","UUENCODE",CNT)
+10 SET ^MDD(703.1,MDIEN,.1,MDDZ,.2,CNT,0)=LINE
+11 SET CNT2=CNT
+12 QUIT
End DoDot:1
+13 DO NOW^%DTC
+14 SET ^MDD(703.1,MDIEN,.1,MDDZ,.2,0)="^^"_CNT2_"^"_CNT2_"^"_$PIECE(%,".")_"^"
+15 QUIT
XML ;;PROCESS XML;.306
+1 NEW CNT
+2 SET CNT=0
+3 FOR
SET CNT=$ORDER(^TMP($JOB,"MDHL7A",CNT))
if CNT<1
QUIT
Begin DoDot:1
+4 NEW LINE,PATH
+5 SET LINE=^TMP($JOB,"MDHL7A",CNT)
if LINE=""
QUIT
+6 IF $PIECE(LINE,"|",1)'="OBX"
QUIT
+7 DO PATHCHK(LINE,.PATH)
+8 ; Create the entry in the multi.
IF PATH
SET MDDZ=$$UPDATE^MDHL7U(MDIEN)
+9 if 'MDDZ
QUIT
+10 SET ^MDD(703.1,MDIEN,.1,MDDZ,0)=$PIECE(MDATT(PROC),";",6)
+11 SET ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
+12 QUIT
End DoDot:1
+13 QUIT
XMS ;;PROCESS XMS;.307
+1 NEW CNT
+2 SET CNT=0
+3 FOR
SET CNT=$ORDER(^TMP($JOB,"MDHL7A",CNT))
if CNT<1
QUIT
Begin DoDot:1
+4 NEW LINE,PATH
+5 SET LINE=^TMP($JOB,"MDHL7A",CNT)
if LINE=""
QUIT
+6 IF $PIECE(LINE,"|",1)'="OBX"
QUIT
+7 DO PATHCHK(LINE,.PATH)
+8 ; Create the entry in the multi.
IF PATH
SET MDDZ=$$UPDATE^MDHL7U(MDIEN)
+9 if 'MDDZ
QUIT
+10 SET ^MDD(703.1,MDIEN,.1,MDDZ,0)=$PIECE(MDATT(PROC),";",6)
+11 SET ^MDD(703.1,MDIEN,.1,MDDZ,.1)=PATH("FPATH")
+12 QUIT
End DoDot:1
+13 QUIT
