PXBHLP0.m

PXBHLP0 ;ISL/JVS - MAIN HELP DRIVING ROUTINE ;11/5/96  14:25

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996

 ;

 ;

 ;

EN1(PACK,SUBJ,INTR,BODY,LEVEL) ;--MAIN ENTRY POINT TO HELP

 ;

 ;

 ;  PACK    - Package that is calling for help (REQUIRED)

 ;  SUBJ    - Subject that the help is about (REQUIRED)

 ;  INTR    - Line number on which to write the INTRODUCTION

 ;  BODY    - Line number on which to write the BODY

 ;

 ;  PXBREC  - The node in the PHBHLPR routine

 ;

 I '$D(PACK),'$D(SUBJ) W !," Requires the Package and the Subject!! "

 ;

NEW ;----New any necessary Items

 N TAG,RTN,LENGTH,PLACE,BLENGTH

 K NOREV

 ;

SET ;-----Set up Variables needed for HELP

 D TERM^PXBCC

 I $D(LEVEL),LEVEL=1 S TAG="INTRO"

 I $D(LEVEL),LEVEL=2 S TAG="BODY"

 ;

 ;

NODE ;

 I '$D(TAG) Q

 S PXBNOD=PACK_SUBJ D EN1^PXBHLPR I PXBREC="" S PXBREC=-1 Q

 ;---GET LENGTH OF TAG FROM ROUTINE IN FIRST PIECE OF PXBREC

 ;

 S ROUTINE=$P($P(PXBREC,"~",1),"^",2)

 D SIZE

 ;

 ;----CLEAN OFF THE SCREEN

 D CLEAN(LENGTH)

 ;

 ;

 ;---WRITE THE TEXT TO THE SCREEN

 I $D(IOEDEOP),PACK="PXB" W IOEDEOP

 I TAG="INTRO" D @$P(PXBREC,"~",1) Q

 I TAG="BODY" D @$P(PXBREC,"~",2)

 I TAG'="INTRO",TAG'="BODY" S RTN=TAG_"^"_$P($P(PXBREC,"~",2),"^",2) D

 .D @RTN

 I $G(TAG)>0 Q

 ;----D THE PROMPT

 ;

 D @$P(PXBREC,"~",3)

 I TAG=""!(TAG["^") Q

 G NODE

 Q

 ;--------------------------SUB ROUTINES---------------------------------

 ;

CLEAN(LENGTH) ;---Clean off the Screen where the message will be.

 D PLACE

 S (IOBM,IOTM)=0 W @IOSTBM

 I $D(INTR),$G(PLACE) D

 .D LOC^PXBCC(PLACE,0) F I=1:1:LENGTH W IORI,IOELALL

 I $D(BODY),$G(PLACE) D

 .D LOC^PXBCC(PLACE,0) F I=1:1:LENGTH W IORI,IOELALL

 Q

SIZE ;-----GET THE SIZE OF THE SPACE OF THE DATA

 ;-----------------------------------

 S X="LENGTH=$P($T("_TAG_"^"_ROUTINE_"),"";;"",2)"

 S @X

 I TAG="BODY" S BLENGTH=LENGTH

 ;----------------------------------------------

 ;

 Q

PLACE ;----CALCULATE THE PLACEMENT OF THE HELP FOR PXB*

 N HDR

 I $D(BLENGTH) S LENGTH=BLENGTH

 S HDR=4

 S PLACE=HDR+PXBCNT+1+LENGTH

 I PLACE<17 Q

 I PLACE>16 S PLACE=4+LENGTH,NOREV=1

 Q

PXBHLP0   ;ISL/JVS - MAIN HELP DRIVING ROUTINE ;11/5/96  14:25

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996

 +2       ;

 +3       ;

 +4       ;

EN1(PACK,SUBJ,INTR,BODY,LEVEL) ;--MAIN ENTRY POINT TO HELP

 +1       ;

 +2       ;

 +3       ;  PACK    - Package that is calling for help (REQUIRED)

 +4       ;  SUBJ    - Subject that the help is about (REQUIRED)

 +5       ;  INTR    - Line number on which to write the INTRODUCTION

 +6       ;  BODY    - Line number on which to write the BODY

 +7       ;

 +8       ;  PXBREC  - The node in the PHBHLPR routine

 +9       ;

 +10       IF '$DATA(PACK)

               IF '$DATA(SUBJ)

                   WRITE !," Requires the Package and the Subject!! "

 +11      ;

NEW       ;----New any necessary Items

 +1        NEW TAG,RTN,LENGTH,PLACE,BLENGTH

 +2        KILL NOREV

 +3       ;

SET       ;-----Set up Variables needed for HELP

 +1        DO TERM^PXBCC

 +2        IF $DATA(LEVEL)

               IF LEVEL=1

                   SET TAG="INTRO"

 +3        IF $DATA(LEVEL)

               IF LEVEL=2

                   SET TAG="BODY"

 +4       ;

 +5       ;

NODE      ;

 +1        IF '$DATA(TAG)

               QUIT 

 +2        SET PXBNOD=PACK_SUBJ

           DO EN1^PXBHLPR

           IF PXBREC=""

               SET PXBREC=-1

               QUIT 

 +3       ;---GET LENGTH OF TAG FROM ROUTINE IN FIRST PIECE OF PXBREC

 +4       ;

 +5        SET ROUTINE=$PIECE($PIECE(PXBREC,"~",1),"^",2)

 +6        DO SIZE

 +7       ;

 +8       ;----CLEAN OFF THE SCREEN

 +9        DO CLEAN(LENGTH)

 +10      ;

 +11      ;

 +12      ;---WRITE THE TEXT TO THE SCREEN

 +13       IF $DATA(IOEDEOP)

               IF PACK="PXB"

                   WRITE IOEDEOP

 +14       IF TAG="INTRO"

               DO @$PIECE(PXBREC,"~",1)

               QUIT 

 +15       IF TAG="BODY"

               DO @$PIECE(PXBREC,"~",2)

 +16       IF TAG'="INTRO"

               IF TAG'="BODY"

                   SET RTN=TAG_"^"_$PIECE($PIECE(PXBREC,"~",2),"^",2)

                   Begin DoDot:1

 +17                   DO @RTN

                   End DoDot:1

 +18       IF $GET(TAG)>0

               QUIT 

 +19      ;----D THE PROMPT

 +20      ;

 +21       DO @$PIECE(PXBREC,"~",3)

 +22       IF TAG=""!(TAG["^")

               QUIT 

 +23       GOTO NODE

 +24       QUIT 

 +25      ;--------------------------SUB ROUTINES---------------------------------

 +26      ;

CLEAN(LENGTH) ;---Clean off the Screen where the message will be.

 +1        DO PLACE

 +2        SET (IOBM,IOTM)=0

           WRITE @IOSTBM

 +3        IF $DATA(INTR)

               IF $GET(PLACE)

                   Begin DoDot:1

 +4                    DO LOC^PXBCC(PLACE,0)

                       FOR I=1:1:LENGTH

                           WRITE IORI,IOELALL

                   End DoDot:1

 +5        IF $DATA(BODY)

               IF $GET(PLACE)

                   Begin DoDot:1

 +6                    DO LOC^PXBCC(PLACE,0)

                       FOR I=1:1:LENGTH

                           WRITE IORI,IOELALL

                   End DoDot:1

 +7        QUIT 

SIZE      ;-----GET THE SIZE OF THE SPACE OF THE DATA

 +1       ;-----------------------------------

 +2        SET X="LENGTH=$P($T("_TAG_"^"_ROUTINE_"),"";;"",2)"

 +3        SET @X

 +4        IF TAG="BODY"

               SET BLENGTH=LENGTH

 +5       ;----------------------------------------------

 +6       ;

 +7        QUIT 

PLACE     ;----CALCULATE THE PLACEMENT OF THE HELP FOR PXB*

 +1        NEW HDR

 +2        IF $DATA(BLENGTH)

               SET LENGTH=BLENGTH

 +3        SET HDR=4

 +4        SET PLACE=HDR+PXBCNT+1+LENGTH

 +5        IF PLACE<17

               QUIT 

 +6        IF PLACE>16

               SET PLACE=4+LENGTH

               SET NOREV=1

 +7        QUIT