MDHL7K2 ; HOIFO/WAA -HP EnConcert Echo ; 06/08/00
;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
N TCNT,ICNT,LN
S (TCNT,ICNT,LN)=0
OBX ; Process OBX
N MDATT,PROC
D ATT^MDHL7U(DEVIEN,.MDATT) Q:MDATT<1
S PROC=0
F S PROC=$O(MDATT(PROC)) Q:PROC<1 D
. N PROCESS
. S PROCESS=$P(MDATT(PROC),";",5)
. I PROCESS="TEXT^MDHL7U2" D TXT
. D @PROCESS
. Q
Q:'MDIEN
D REX^MDHL7U1(MDIEN)
D GENACK^MDHL7X
Q
TXT ; Rebuild the text message for CLINICAL PROCEDURES
N MDHLD,CNT,CNT2,LINE,P,TIM1,TIM2,TIME,MDDT,MDHT,MSGC,TITLE,TITLE1
S P="|"
S (CNT,CNT2,TITLE,TITLE1)=0
F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
.S LINE=^TMP($J,"MDHL7A",CNT)
.I $P(LINE,P,1)'="OBX" Q
.I $P(LINE,P,3)'="TX" Q
.I $E($P(LINE,P,6),1,2)="//" Q
.I $E($P(LINE,P,6),1,2)="\\" Q
.S TITLE=$P(LINE,P,4),TITLE=$P(TITLE,U,2)
.I TITLE="PreliminaryReader" D
.. N MN,ML,MF,MI,MS,MT
.. S MN=$P(LINE,P,6),ML=$P(MN,U,2)
.. S MF=$P(MN,U,3),MI=$P(MN,U,4)
.. S MS=$P(MN,U,5),MT=$P(MN,U,6)
.. S MN=MF
.. I MI'="" S MN=MN_" "_MI_"."
.. S MN=MN_" "_ML
.. I MS'="" S MN=MN_", "_MS_"."
.. I MT'="" S MN=MN_", "_MT
.. S $P(LINE,P,6)=MN
..Q
.I TITLE'=TITLE1 D
.. N LBL
.. S CNT2=CNT2+1,^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX||| "
.. S CNT2=CNT2+1
.. S LBL=$P(TITLE,"&",2)
.. I LBL="" S LBL=$P(TITLE,"&")
.. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LBL,TITLE1=TITLE
.. Q
.S CNT2=CNT2+1,^TMP($J,"MDHL7","TEXT",CNT2)=LINE
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDHL7K2 1457 printed Nov 22, 2024@16:53 Page 2
MDHL7K2 ; HOIFO/WAA -HP EnConcert Echo ; 06/08/00
+1 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
+2 NEW TCNT,ICNT,LN
+3 SET (TCNT,ICNT,LN)=0
OBX ; Process OBX
+1 NEW MDATT,PROC
+2 DO ATT^MDHL7U(DEVIEN,.MDATT)
if MDATT<1
QUIT
+3 SET PROC=0
+4 FOR
SET PROC=$ORDER(MDATT(PROC))
if PROC<1
QUIT
Begin DoDot:1
+5 NEW PROCESS
+6 SET PROCESS=$PIECE(MDATT(PROC),";",5)
+7 IF PROCESS="TEXT^MDHL7U2"
DO TXT
+8 DO @PROCESS
+9 QUIT
End DoDot:1
+10 if 'MDIEN
QUIT
+11 DO REX^MDHL7U1(MDIEN)
+12 DO GENACK^MDHL7X
+13 QUIT
TXT ; Rebuild the text message for CLINICAL PROCEDURES
+1 NEW MDHLD,CNT,CNT2,LINE,P,TIM1,TIM2,TIME,MDDT,MDHT,MSGC,TITLE,TITLE1
+2 SET P="|"
+3 SET (CNT,CNT2,TITLE,TITLE1)=0
+4 FOR
SET CNT=$ORDER(^TMP($JOB,"MDHL7A",CNT))
if CNT<1
QUIT
Begin DoDot:1
+5 SET LINE=^TMP($JOB,"MDHL7A",CNT)
+6 IF $PIECE(LINE,P,1)'="OBX"
QUIT
+7 IF $PIECE(LINE,P,3)'="TX"
QUIT
+8 IF $EXTRACT($PIECE(LINE,P,6),1,2)="//"
QUIT
+9 IF $EXTRACT($PIECE(LINE,P,6),1,2)="\\"
QUIT
+10 SET TITLE=$PIECE(LINE,P,4)
SET TITLE=$PIECE(TITLE,U,2)
+11 IF TITLE="PreliminaryReader"
Begin DoDot:2
+12 NEW MN,ML,MF,MI,MS,MT
+13 SET MN=$PIECE(LINE,P,6)
SET ML=$PIECE(MN,U,2)
+14 SET MF=$PIECE(MN,U,3)
SET MI=$PIECE(MN,U,4)
+15 SET MS=$PIECE(MN,U,5)
SET MT=$PIECE(MN,U,6)
+16 SET MN=MF
+17 IF MI'=""
SET MN=MN_" "_MI_"."
+18 SET MN=MN_" "_ML
+19 IF MS'=""
SET MN=MN_", "_MS_"."
+20 IF MT'=""
SET MN=MN_", "_MT
+21 SET $PIECE(LINE,P,6)=MN
+22 QUIT
End DoDot:2
+23 IF TITLE'=TITLE1
Begin DoDot:2
+24 NEW LBL
+25 SET CNT2=CNT2+1
SET ^TMP($JOB,"MDHL7","TEXT",CNT2)="OBX||TX||| "
+26 SET CNT2=CNT2+1
+27 SET LBL=$PIECE(TITLE,"&",2)
+28 IF LBL=""
SET LBL=$PIECE(TITLE,"&")
+29 SET ^TMP($JOB,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LBL
SET TITLE1=TITLE
+30 QUIT
End DoDot:2
+31 SET CNT2=CNT2+1
SET ^TMP($JOB,"MDHL7","TEXT",CNT2)=LINE
+32 QUIT
End DoDot:1
+33 QUIT
