ADED.m

ADED ; IHS/HQT/MJL - IHS-RPMS/MLQ SET KERNEL VARIABLES, WRITE KERNEL HEADER ;  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

 ;PARAMETER GLOBAL NAME IS SET IN MAIN GARS MENU FOR THAT DISCIPLINE

 S ADEPGLOB=ADEPGLB_"1,0)",ADEPGLOB=@ADEPGLOB

 S ADEKERNM=$P(ADEPGLOB,"^")

 S ADENMSP=$P(ADEPGLOB,"^",2)

 I ADENMSP="" W !,"Your NAMESPACE field is not set in the GENERIC PARAMETER file.  Please contact  your support person.",!! S XQUIT=1 Q

 S ADEPRVFN=$P(ADEPGLOB,"^",3)

 S ADEPRMFN=$P(ADEPGLOB,"^",4)

 S ADEY="",ADEY=$O(^DIC(9.4,"C",ADENMSP,ADEY))

 I ADEY="" W !,"Your NAMESPACE isn't recognized by the PACKAGE file.  Version not set in menu   header."  S ADEVER="  "

 E  S ADEVER=^DIC(9.4,ADEY,"VERSION"),ADEVER="VERSION "_ADEVER

 K XQUIT

 I '$D(DUZ(2)) W !,"Your SITE NAME is not set for the KERNEL.  Please contact your System Support person.",!! S XQUIT=1 Q

 S ADESITE=$P(^DIC(4,DUZ(2),0),"^")

 S ADEL2="GENERIC ACTIVITY REPORTING SYSTEM"

PRHDR ;PRINT HEADER

 D ^ADECLS

 W !,?75-$L(ADEKERNM)\2,ADEKERNM

 W !,?75-$L(ADEL2)\2,ADEL2

 W !,?75-$L(ADEVER)\2,ADEVER

 W !,?75-$L(ADESITE)\2,ADESITE

 Q

ADEX ;MAIN MENU EXIT ENTRY POINT

 K ADEPGLOB,ADEPGLB,ADEKERNM,ADENMSP,ADEPRVFN,ADEPRMFN,ADEY,ADEVER,ADESITE,ADEL2,ADEDUZ

 Q

DE ;DATA ENTRY ENTRY POINT

 ;

 S ADEL2="DATA ENTRY MENU"

 D PRHDR

 Q

DEX ;DATA ENTRY EXIT ENTRY POINT

 K ADEL2

 Q

RP ;REPORT MENU ENTRY POINT

 S ADEL2="REPORTS MENU"

 D PRHDR

 Q

RPX ;REPORT MENU EXIT ENTRY POINT

 K ADEL2

 Q

ADED      ; IHS/HQT/MJL - IHS-RPMS/MLQ SET KERNEL VARIABLES, WRITE KERNEL HEADER ;  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

 +2       ;PARAMETER GLOBAL NAME IS SET IN MAIN GARS MENU FOR THAT DISCIPLINE

 +3        SET ADEPGLOB=ADEPGLB_"1,0)"

           SET ADEPGLOB=@ADEPGLOB

 +4        SET ADEKERNM=$PIECE(ADEPGLOB,"^")

 +5        SET ADENMSP=$PIECE(ADEPGLOB,"^",2)

 +6        IF ADENMSP=""

               WRITE !,"Your NAMESPACE field is not set in the GENERIC PARAMETER file.  Please contact  your support person.",!!

               SET XQUIT=1

               QUIT 

 +7        SET ADEPRVFN=$PIECE(ADEPGLOB,"^",3)

 +8        SET ADEPRMFN=$PIECE(ADEPGLOB,"^",4)

 +9        SET ADEY=""

           SET ADEY=$ORDER(^DIC(9.4,"C",ADENMSP,ADEY))

 +10       IF ADEY=""

               WRITE !,"Your NAMESPACE isn't recognized by the PACKAGE file.  Version not set in menu   header."

               SET ADEVER="  "

 +11      IF '$TEST

               SET ADEVER=^DIC(9.4,ADEY,"VERSION")

               SET ADEVER="VERSION "_ADEVER

 +12       KILL XQUIT

 +13       IF '$DATA(DUZ(2))

               WRITE !,"Your SITE NAME is not set for the KERNEL.  Please contact your System Support person.",!!

               SET XQUIT=1

               QUIT 

 +14       SET ADESITE=$PIECE(^DIC(4,DUZ(2),0),"^")

 +15       SET ADEL2="GENERIC ACTIVITY REPORTING SYSTEM"

PRHDR     ;PRINT HEADER

 +1        DO ^ADECLS

 +2        WRITE !,?75-$LENGTH(ADEKERNM)\2,ADEKERNM

 +3        WRITE !,?75-$LENGTH(ADEL2)\2,ADEL2

 +4        WRITE !,?75-$LENGTH(ADEVER)\2,ADEVER

 +5        WRITE !,?75-$LENGTH(ADESITE)\2,ADESITE

 +6        QUIT 

ADEX      ;MAIN MENU EXIT ENTRY POINT

 +1        KILL ADEPGLOB,ADEPGLB,ADEKERNM,ADENMSP,ADEPRVFN,ADEPRMFN,ADEY,ADEVER,ADESITE,ADEL2,ADEDUZ

 +2        QUIT 

DE        ;DATA ENTRY ENTRY POINT

 +1       ;

 +2        SET ADEL2="DATA ENTRY MENU"

 +3        DO PRHDR

 +4        QUIT 

DEX       ;DATA ENTRY EXIT ENTRY POINT

 +1        KILL ADEL2

 +2        QUIT 

RP        ;REPORT MENU ENTRY POINT

 +1        SET ADEL2="REPORTS MENU"

 +2        DO PRHDR

 +3        QUIT 

RPX       ;REPORT MENU EXIT ENTRY POINT

 +1        KILL ADEL2

 +2        QUIT