ADGVAR.m

ADGVAR ; IHS/ADC/PDW/ENM - VARIABLE SET AND KILL ;  [ 03/25/1999  11:48 AM ]

 ;;5.3;ADMISSION/DISCHARGE/TRANSFER;**1012,1015**;MAR 25, 1999;Build 21

 ;

VERSION ;EP; entry point called by main menu

 ;

L1 D RVON W @IOF W !?31,"*****************",!?27,"**",?50,"**"

L2 W !?24,"**   INDIAN HEALTH SERVICE   **"

 W !?19,"** ADMISSION/DISCHARGE/TRANSFER SYSTEM **"

 S DGX=$O(^DIC(9.4,"C","DG",0))

 I DGX="" W !!,"VERSION ERROR; NOTIFY YOUR SITE MANAGER!",!! Q

VERS W !?24,"**        VERSION ",^DIC(9.4,DGX,"VERSION"),"        **"

 W !?27,"**",?50,"**",!?30,"******************"

 ;

SITE I '$D(DUZ(2)) W !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE ADT!" S XQUIT=1 Q

 S DGX=$P($G(^DIC(4,DUZ(2),0)),U) W !!?80-$L(DGX)\2,DGX

 I DGX="" W !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!" S XQUIT="" Q

 S DGSITE=$S($D(^AUTTSITE(1,0)):$P(^(0),U),1:"")

 I DGSITE="" W *7,!!,"ADMITTING FACILITY IS NOT DEFINED",!,"NOTIFY YOUR SITE MANGER" S XQUIT=1 K DGSITE Q

 ;W !,"DGSITE: ",DGSITE

 I DUZ(2)'=DGSITE W *7,!!,"YOU ARE NOT SET TO THE ADMITTING FACILITY",!,"NOTIFY YOUR SITE MANAGER" S XQUIT=1

 K DGSITE,DGX I $D(XQUIT) G QUIT

 ;

VAR ;PEP;***> set package variables from site parameter file

 ; -- can be called by other packages that need to check

 ;      mas parameters

 I '$D(^DG(43,1,9999999))!('$D(^DG(43,1,9999999.01))) W !!,*7,?20,"ADT Site Parameters are not set up!",!?10,"DO NOT use ADT until System Definition has been completed!",!! G QUIT

 S DGOPT("GEN")=^DG(43,1,9999999),DGOPT("QA")=^DG(43,1,9999999.01)

 ;ihs/cmi/maw 04/07/2012 PATCH 1015 put next line back in

 S DGOPT("QA1")=$G(^DG(43,1,9999999.02))  ;cmi/maw 06/15/2010 PATCH 1012 not in data dictionary

 Q

 ;

QUIT ;PEP - kill variables and quit

 K DGAB,DGAB9,DGAS,DGAU,DGDE,DGDEWA,DGDIR,DGDIS,DGDOM,DGFA,DGFA9

 K DGFS,DGFU,DGHEM,DGNHCU,DGOP,DGREH,DGTI,DGTO,DGU,L,MASD,MASDEV

 K PARA,USER,STR,STR1,DGV

 K DGOPT,DGZRVN,DGZRVF Q  ;kill IHS package-wide variables

 ;

MENU ;ENTRY POINT  >>> entry action for all submenus

 S ADG("TITLE")=$P($G(XQY0),U,2)

 I $L(ADG("TITLE"))>2 W @IOF,!!?80-$L(ADG("TITLE"))/2,ADG("TITLE")

 S X=$P($G(^DIC(4,DUZ(2),0)),U)

 W !!?80-$L(X)\2,"(",X,")"

 K ADG

 Q

 ;

PRTOPT ;ENTRY POINT  >>> exit action for print options

 NEW X,Y,Z

 Q:IOST'["C-"

 K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR W @IOF

 K DIR Q

 ;

RVON ;EP;***> set reverse video variables

 S (DGZRVN,DGZRVF)="" I '$D(IO) S IO=""

 I IO="" S IOP="" D ^%ZIS

 I $D(^%ZIS(2,IOST(0),5)) S DGZRVN=$P(^(5),U,4),DGZRVF=$P(^(5),U,5)

 Q

ADGVAR    ; IHS/ADC/PDW/ENM - VARIABLE SET AND KILL ;  [ 03/25/1999  11:48 AM ]

 +1       ;;5.3;ADMISSION/DISCHARGE/TRANSFER;**1012,1015**;MAR 25, 1999;Build 21

 +2       ;

VERSION   ;EP; entry point called by main menu

 +1       ;

L1         DO RVON

           WRITE @IOF

           WRITE !?31,"*****************",!?27,"**",?50,"**"

L2         WRITE !?24,"**   INDIAN HEALTH SERVICE   **"

 +1        WRITE !?19,"** ADMISSION/DISCHARGE/TRANSFER SYSTEM **"

 +2        SET DGX=$ORDER(^DIC(9.4,"C","DG",0))

 +3        IF DGX=""

               WRITE !!,"VERSION ERROR; NOTIFY YOUR SITE MANAGER!",!!

               QUIT 

VERS       WRITE !?24,"**        VERSION ",^DIC(9.4,DGX,"VERSION"),"        **"

 +1        WRITE !?27,"**",?50,"**",!?30,"******************"

 +2       ;

SITE       IF '$DATA(DUZ(2))

               WRITE !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE ADT!"

               SET XQUIT=1

               QUIT 

 +1        SET DGX=$PIECE($GET(^DIC(4,DUZ(2),0)),U)

           WRITE !!?80-$LENGTH(DGX)\2,DGX

 +2        IF DGX=""

               WRITE !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!"

               SET XQUIT=""

               QUIT 

 +3        SET DGSITE=$SELECT($DATA(^AUTTSITE(1,0)):$PIECE(^(0),U),1:"")

 +4        IF DGSITE=""

               WRITE *7,!!,"ADMITTING FACILITY IS NOT DEFINED",!,"NOTIFY YOUR SITE MANGER"

               SET XQUIT=1

               KILL DGSITE

               QUIT 

 +5       ;W !,"DGSITE: ",DGSITE

 +6        IF DUZ(2)'=DGSITE

               WRITE *7,!!,"YOU ARE NOT SET TO THE ADMITTING FACILITY",!,"NOTIFY YOUR SITE MANAGER"

               SET XQUIT=1

 +7        KILL DGSITE,DGX

           IF $DATA(XQUIT)

               GOTO QUIT

 +8       ;

VAR       ;PEP;***> set package variables from site parameter file

 +1       ; -- can be called by other packages that need to check

 +2       ;      mas parameters

 +3        IF '$DATA(^DG(43,1,9999999))!('$DATA(^DG(43,1,9999999.01)))

               WRITE !!,*7,?20,"ADT Site Parameters are not set up!",!?10,"DO NOT use ADT until System Definition has been completed!",!!

               GOTO QUIT

 +4        SET DGOPT("GEN")=^DG(43,1,9999999)

           SET DGOPT("QA")=^DG(43,1,9999999.01)

 +5       ;ihs/cmi/maw 04/07/2012 PATCH 1015 put next line back in

 +6       ;cmi/maw 06/15/2010 PATCH 1012 not in data dictionary

           SET DGOPT("QA1")=$GET(^DG(43,1,9999999.02))

 +7        QUIT 

 +8       ;

QUIT      ;PEP - kill variables and quit

 +1        KILL DGAB,DGAB9,DGAS,DGAU,DGDE,DGDEWA,DGDIR,DGDIS,DGDOM,DGFA,DGFA9

 +2        KILL DGFS,DGFU,DGHEM,DGNHCU,DGOP,DGREH,DGTI,DGTO,DGU,L,MASD,MASDEV

 +3        KILL PARA,USER,STR,STR1,DGV

 +4       ;kill IHS package-wide variables

           KILL DGOPT,DGZRVN,DGZRVF

           QUIT 

 +5       ;

MENU      ;ENTRY POINT  >>> entry action for all submenus

 +1        SET ADG("TITLE")=$PIECE($GET(XQY0),U,2)

 +2        IF $LENGTH(ADG("TITLE"))>2

               WRITE @IOF,!!?80-$LENGTH(ADG("TITLE"))/2,ADG("TITLE")

 +3        SET X=$PIECE($GET(^DIC(4,DUZ(2),0)),U)

 +4        WRITE !!?80-$LENGTH(X)\2,"(",X,")"

 +5        KILL ADG

 +6        QUIT 

 +7       ;

PRTOPT    ;ENTRY POINT  >>> exit action for print options

 +1        NEW X,Y,Z

 +2        IF IOST'["C-"

               QUIT 

 +3        KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press RETURN to continue"

           DO ^DIR

           WRITE @IOF

 +4        KILL DIR

           QUIT 

 +5       ;

RVON      ;EP;***> set reverse video variables

 +1        SET (DGZRVN,DGZRVF)=""

           IF '$DATA(IO)

               SET IO=""

 +2        IF IO=""

               SET IOP=""

               DO ^%ZIS

 +3        IF $DATA(^%ZIS(2,IOST(0),5))

               SET DGZRVN=$PIECE(^(5),U,4)

               SET DGZRVF=$PIECE(^(5),U,5)

 +4        QUIT