- HLCSORA2 ;ALB/MFK - OUTPUT ROUTINE FOR HL7- 11/10/94
- ;;1.6;HEALTH LEVEL SEVEN;;Oct 13, 1995
- START ;
- N HLAAA,HLDONE,HLLINE,HLPAGE,HLTODAY,HLTITLE,HLDATA,%H,DIRUT,X,Y
- S HLDONE=0,HLLINE="",%H=$P($H,",",1),HLPAGE=1
- D YX^%DTC
- S HLTODAY=Y,HLTITLE="HL7 LOGICAL LINK INFORMATION"
- D HLTITLE
- F S HLLINE=$O(^TMP("HLCSORAT",$J,HLLINE)) Q:(HLLINE="")!(HLDONE) D LINEE
- Q
- LINEE ;
- S HLDATA=""
- LINE Q:HLDONE!(HLLINE="")
- D:$Y+4>IOSL HEADING
- Q:HLDONE
- S HLDATA=$O(^TMP("HLCSORAT",$J,HLLINE,HLDATA)) Q:(HLDATA="")
- S HLZ=1
- W $G(^TMP("HLCSORAT",$J,HLLINE,HLDATA)),!
- G LINE
- Q
- HEADING ;
- F HLAAA=$Y:1:(IOSL-3) W !
- ; if a CRT device, ask for RETURN to continue or "^" to quit
- I ($E(IOST,1,2)="C-")
- I S DIR(0)="E" D ^DIR K DIR I Y=0!(Y="")!($D(DIRUT)) S HLDONE=1 Q
- D HLTITLE
- Q
- HLTITLE Q:HLDONE
- I ($E(IOST,1,2)="C-")!(HLPAGE'=1) W @IOF
- W !,HLTODAY,?25,HLTITLE,?68," PAGE ",HLPAGE,!
- S X="",$P(X,"=",IOM)="" W X,!
- S HLPAGE=HLPAGE+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSORA2 968 printed Jan 18, 2025@02:58:02 Page 2
- HLCSORA2 ;ALB/MFK - OUTPUT ROUTINE FOR HL7- 11/10/94
- +1 ;;1.6;HEALTH LEVEL SEVEN;;Oct 13, 1995
- START ;
- +1 NEW HLAAA,HLDONE,HLLINE,HLPAGE,HLTODAY,HLTITLE,HLDATA,%H,DIRUT,X,Y
- +2 SET HLDONE=0
- SET HLLINE=""
- SET %H=$PIECE($HOROLOG,",",1)
- SET HLPAGE=1
- +3 DO YX^%DTC
- +4 SET HLTODAY=Y
- SET HLTITLE="HL7 LOGICAL LINK INFORMATION"
- +5 DO HLTITLE
- +6 FOR
- SET HLLINE=$ORDER(^TMP("HLCSORAT",$JOB,HLLINE))
- if (HLLINE="")!(HLDONE)
- QUIT
- DO LINEE
- +7 QUIT
- LINEE ;
- +1 SET HLDATA=""
- LINE if HLDONE!(HLLINE="")
- QUIT
- +1 if $Y+4>IOSL
- DO HEADING
- +2 if HLDONE
- QUIT
- +3 SET HLDATA=$ORDER(^TMP("HLCSORAT",$JOB,HLLINE,HLDATA))
- if (HLDATA="")
- QUIT
- +4 SET HLZ=1
- +5 WRITE $GET(^TMP("HLCSORAT",$JOB,HLLINE,HLDATA)),!
- +6 GOTO LINE
- +7 QUIT
- HEADING ;
- +1 FOR HLAAA=$Y:1:(IOSL-3)
- WRITE !
- +2 ; if a CRT device, ask for RETURN to continue or "^" to quit
- +3 IF ($EXTRACT(IOST,1,2)="C-")
- +4 IF $TEST
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="")!($DATA(DIRUT))
- SET HLDONE=1
- QUIT
- +5 DO HLTITLE
- +6 QUIT
- HLTITLE if HLDONE
- QUIT
- +1 IF ($EXTRACT(IOST,1,2)="C-")!(HLPAGE'=1)
- WRITE @IOF
- +2 WRITE !,HLTODAY,?25,HLTITLE,?68," PAGE ",HLPAGE,!
- +3 SET X=""
- SET $PIECE(X,"=",IOM)=""
- WRITE X,!
- +4 SET HLPAGE=HLPAGE+1
- +5 QUIT