GMRADSP8.m

GMRADSP8 ;HIRMFO/WAA-DISPLAY ALLERGY ;26-Oct-2010 17:03;DU

 ;;4.0;Adverse Reaction Tracking;**1002**;Mar 29, 1996;Build 32

 ;IHS/MSC/MGH added source to header

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,40,"SOURCE"),WRITE(0,53,"VER."),WRITE(0,59," MECH. "),WRITE(0,68,"HIST"),WRITE(0,74,"TYPE")

 D WRITE(1,0,"--------"),WRITE(0,40,"------"),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

GMRADSP8  ;HIRMFO/WAA-DISPLAY ALLERGY ;26-Oct-2010 17:03;DU

 +1       ;;4.0;Adverse Reaction Tracking;**1002**;Mar 29, 1996;Build 32

 +2       ;IHS/MSC/MGH added source to header

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,40,"SOURCE")

           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,40,"------")

           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