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  Sep 23, 2025@19:32:53                                                                                                                                                                                                     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