- 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 Mar 13, 2025@20:47:28 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
