GMRADSP8 ;HIRMFO/WAA-DISPLAY ALLERGY ;9/6/95 11:06
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
DISPLAY(ARRAY) ;This subroutine will print out the Reactant
; ARRAY is the array that is passed
N CNT
Q:'$D(ARRAY)
D WRITE(1,0,.ARRAY,.GMRAOUT,"HEAD^GMRADSP8")
Q
HEAD ;Print the top of page for the display
W #
D WRITE(2,68,"OBS/")
D WRITE(1,0,"REACTANT"),WRITE(0,53,"VER."),WRITE(0,59," MECH. "),WRITE(0,68,"HIST"),WRITE(0,74,"TYPE")
D WRITE(1,0,"--------"),WRITE(0,53,"----"),WRITE(0,59,"-------"),WRITE(0,68,"----"),WRITE(0,74,"----")
Q
;
WRITE(NL,TAB,STRING,GMRAOUT,HEAD) ; This will display all the
; text in a given string.
; Requited Variables:
; NL = Numeric repersentation of New lines
; = 0 No new line
; TAB = Number of tab spaces from the las given position
; STRING = The array of text to be printed.
; STRING(X) = Continue of string
; NOTE: This continuation will line feed and tab the same
; as the string itself.
; Optional variables
; GMRAOUT = The status of the Up-arrow out of a system.
; = "" use Page break function
; HEAD = HEADER SUB-ROUTINE
;
S GMRAOUT=$G(GMRAOUT),HEAD=$G(HEAD)
N GMAI,GMAX
I $G(STRING)'="" D Q:GMRAOUT W ?TAB,STRING
.I NL F GMAI=1:1:NL S:GMRAOUT'="" GMRAOUT=$$PAGE(HEAD) Q:GMRAOUT W !
.Q
S GMAX=0 F S GMAX=$O(STRING(GMAX)) Q:GMAX<1 D Q:GMRAOUT W ?TAB,STRING(GMAX)
.I NL F GMAI=1:1:NL S:GMRAOUT'="" GMRAOUT=$$PAGE(HEAD) Q:GMRAOUT W !
.Q
Q
PAGE(HEAD) ; Bottom of page program
; Input variable:
; HEAD = Header program to be run
;
S GMRAOUT=0
D:$Y>(IOSL-3)
.N DIR,Y
.S DIR(0)="E",DIR("A")="Press RETURN to continue or '^' to stop listing"
.S DIR("?")=" Press RETURN to continue, '^' stop reactant listing."
.W ! D ^DIR I Y D:HEAD'="" @HEAD Q ;User hit return
.I $D(DTOUT)!$D(DIROUT) S GMRAOUT=1
.I $D(DUOUT) S GMRAOUT=2
.K DIROUT,DTOUT,DIRUT,DUOUT
.Q
Q GMRAOUT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRADSP8 1991 printed Jan 18, 2025@02:40:12 Page 2
GMRADSP8 ;HIRMFO/WAA-DISPLAY ALLERGY ;9/6/95 11:06
+1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
DISPLAY(ARRAY) ;This subroutine will print out the Reactant
+1 ; ARRAY is the array that is passed
+2 NEW CNT
+3 if '$DATA(ARRAY)
QUIT
+4 DO WRITE(1,0,.ARRAY,.GMRAOUT,"HEAD^GMRADSP8")
+5 QUIT
HEAD ;Print the top of page for the display
+1 WRITE #
+2 DO WRITE(2,68,"OBS/")
+3 DO WRITE(1,0,"REACTANT")
DO WRITE(0,53,"VER.")
DO WRITE(0,59," MECH. ")
DO WRITE(0,68,"HIST")
DO WRITE(0,74,"TYPE")
+4 DO WRITE(1,0,"--------")
DO WRITE(0,53,"----")
DO WRITE(0,59,"-------")
DO WRITE(0,68,"----")
DO WRITE(0,74,"----")
+5 QUIT
+6 ;
WRITE(NL,TAB,STRING,GMRAOUT,HEAD) ; This will display all the
+1 ; text in a given string.
+2 ; Requited Variables:
+3 ; NL = Numeric repersentation of New lines
+4 ; = 0 No new line
+5 ; TAB = Number of tab spaces from the las given position
+6 ; STRING = The array of text to be printed.
+7 ; STRING(X) = Continue of string
+8 ; NOTE: This continuation will line feed and tab the same
+9 ; as the string itself.
+10 ; Optional variables
+11 ; GMRAOUT = The status of the Up-arrow out of a system.
+12 ; = "" use Page break function
+13 ; HEAD = HEADER SUB-ROUTINE
+14 ;
+15 SET GMRAOUT=$GET(GMRAOUT)
SET HEAD=$GET(HEAD)
+16 NEW GMAI,GMAX
+17 IF $GET(STRING)'=""
Begin DoDot:1
+18 IF NL
FOR GMAI=1:1:NL
if GMRAOUT'=""
SET GMRAOUT=$$PAGE(HEAD)
if GMRAOUT
QUIT
WRITE !
+19 QUIT
End DoDot:1
if GMRAOUT
QUIT
WRITE ?TAB,STRING
+20 SET GMAX=0
FOR
SET GMAX=$ORDER(STRING(GMAX))
if GMAX<1
QUIT
Begin DoDot:1
+21 IF NL
FOR GMAI=1:1:NL
if GMRAOUT'=""
SET GMRAOUT=$$PAGE(HEAD)
if GMRAOUT
QUIT
WRITE !
+22 QUIT
End DoDot:1
if GMRAOUT
QUIT
WRITE ?TAB,STRING(GMAX)
+23 QUIT
PAGE(HEAD) ; Bottom of page program
+1 ; Input variable:
+2 ; HEAD = Header program to be run
+3 ;
+4 SET GMRAOUT=0
+5 if $Y>(IOSL-3)
Begin DoDot:1
+6 NEW DIR,Y
+7 SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue or '^' to stop listing"
+8 SET DIR("?")=" Press RETURN to continue, '^' stop reactant listing."
+9 ;User hit return
WRITE !
DO ^DIR
IF Y
if HEAD'=""
DO @HEAD
QUIT
+10 IF $DATA(DTOUT)!$DATA(DIROUT)
SET GMRAOUT=1
+11 IF $DATA(DUOUT)
SET GMRAOUT=2
+12 KILL DIROUT,DTOUT,DIRUT,DUOUT
+13 QUIT
End DoDot:1
+14 QUIT GMRAOUT
