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 Nov 22, 2024@17:06:55 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