USRU.m

USRU ; SLC/PKR - Utility subroutines for USR ;1/24/00  11:03

 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,12,13**;Jun 20, 1997

 ;======================================================================

 ;This routine is a direct copy from TIUU.

READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ; Calls reader, returns response

 N DIR,X,Y

 S DIR(0)=TYPE

 I $D(SCREEN) S DIR("S")=SCREEN

 I $G(PROMPT)]"" S DIR("A")=PROMPT

 I $G(DEFAULT)]"" S DIR("B")=DEFAULT

 I $D(HELP) S DIR("?")=HELP

 D ^DIR

 I $G(X)="@" S Y="@" G READX

 I Y]"",($L($G(Y),U)'=2) S Y=Y_U_$G(Y(0),Y)

READX Q Y

 ;

 ;======================================================================

 ; MA - CHECK INPUT TRANSFORM 8930.3 (.04) EFFECTIVE DATE > EXP DATE

VALID(Y) ; USES DA TO FIND RECORD(8930.3)

 ; Check to verify Expiration date is not less than Effective date

 I Y=-1 Q 0 ; If ^%DT returns a -1 value date is invalid. Do not Edit.

 I $P($G(^USR(8930.3,DA,0)),U,3)>Y D  Q 0

 . S X="IORVON;IORVOFF"

 . D ENDR^%ZISS

 . S A(1)=IORVON

 . S A(2)="Can not set Expiration date earlier than Start (Effective) date"

 . S A(3,"F")="!!"

 . S A(3)=IORVOFF

 . D EN^DDIOL(.A)

 Q 1

 ;======================================================================

 ; MA - CHECK INPUT TRANSFORM 8930.3 (.03) EFFECTIVE DATE < EXP DATE

VALID2(Y) ; USES DA TO FIND RECORD(8930.3)

 ; Check and verify Effective date is not greater than Expiration

 I Y=-1 Q 0 ; If ^%DT returns a -1 value date is invalid. Do not Edit.

 I $P($G(^USR(8930.3,DA,0)),U,4)=""  Q 1

 I $P($G(^USR(8930.3,DA,0)),U,4)<Y D  Q 0

 . S X="IORVON;IORVOFF"

 . D ENDR^%ZISS

 . S A(1)=IORVON

 . S A(2)="Can not set Start (Effective) date later than Expiration date"

 . S A(3,"F")="!!"

 . S A(3)=IORVOFF

 . D EN^DDIOL(.A)

 . K A

 Q 1

 ;======================================================================

STOP(PROMPT,SCROLL) ; Call DIR at bottom of screen

 N DIR,X,Y

 I $E(IOST)'="C" S Y="" G STOPX

 I +$G(SCROLL),(IOSL>($Y+5)) F  W ! Q:IOSL<($Y+6)

 S DIR(0)="FO^1:1",DIR("A")=$S($G(PROMPT)]"":PROMPT,1:"Press RETURN to continue or '^' to exit")

 S DIR("?")="Enter '^' to quit present action or '^^' to quit to menu"

 D ^DIR I $D(DIRUT),(Y="") K DIRUT

 S Y=$S(Y="^":0,Y="^^":0,$D(DTOUT):"",Y="":1,1:1_U_Y)

STOPX Q Y

USRU      ; SLC/PKR - Utility subroutines for USR ;1/24/00  11:03

 +1       ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,12,13**;Jun 20, 1997

 +2       ;======================================================================

 +3       ;This routine is a direct copy from TIUU.

READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ; Calls reader, returns response

 +1        NEW DIR,X,Y

 +2        SET DIR(0)=TYPE

 +3        IF $DATA(SCREEN)

               SET DIR("S")=SCREEN

 +4        IF $GET(PROMPT)]""

               SET DIR("A")=PROMPT

 +5        IF $GET(DEFAULT)]""

               SET DIR("B")=DEFAULT

 +6        IF $DATA(HELP)

               SET DIR("?")=HELP

 +7        DO ^DIR

 +8        IF $GET(X)="@"

               SET Y="@"

               GOTO READX

 +9        IF Y]""

               IF ($LENGTH($GET(Y),U)'=2)

                   SET Y=Y_U_$GET(Y(0),Y)

READX      QUIT Y

 +1       ;

 +2       ;======================================================================

 +3       ; MA - CHECK INPUT TRANSFORM 8930.3 (.04) EFFECTIVE DATE > EXP DATE

VALID(Y)  ; USES DA TO FIND RECORD(8930.3)

 +1       ; Check to verify Expiration date is not less than Effective date

 +2       ; If ^%DT returns a -1 value date is invalid. Do not Edit.

           IF Y=-1

               QUIT 0

 +3        IF $PIECE($GET(^USR(8930.3,DA,0)),U,3)>Y

               Begin DoDot:1

 +4                SET X="IORVON;IORVOFF"

 +5                DO ENDR^%ZISS

 +6                SET A(1)=IORVON

 +7                SET A(2)="Can not set Expiration date earlier than Start (Effective) date"

 +8                SET A(3,"F")="!!"

 +9                SET A(3)=IORVOFF

 +10               DO EN^DDIOL(.A)

               End DoDot:1

               QUIT 0

 +11       QUIT 1

 +12      ;======================================================================

 +13      ; MA - CHECK INPUT TRANSFORM 8930.3 (.03) EFFECTIVE DATE < EXP DATE

VALID2(Y) ; USES DA TO FIND RECORD(8930.3)

 +1       ; Check and verify Effective date is not greater than Expiration

 +2       ; If ^%DT returns a -1 value date is invalid. Do not Edit.

           IF Y=-1

               QUIT 0

 +3        IF $PIECE($GET(^USR(8930.3,DA,0)),U,4)=""

               QUIT 1

 +4        IF $PIECE($GET(^USR(8930.3,DA,0)),U,4)<Y

               Begin DoDot:1

 +5                SET X="IORVON;IORVOFF"

 +6                DO ENDR^%ZISS

 +7                SET A(1)=IORVON

 +8                SET A(2)="Can not set Start (Effective) date later than Expiration date"

 +9                SET A(3,"F")="!!"

 +10               SET A(3)=IORVOFF

 +11               DO EN^DDIOL(.A)

 +12               KILL A

               End DoDot:1

               QUIT 0

 +13       QUIT 1

 +14      ;======================================================================

STOP(PROMPT,SCROLL) ; Call DIR at bottom of screen

 +1        NEW DIR,X,Y

 +2        IF $EXTRACT(IOST)'="C"

               SET Y=""

               GOTO STOPX

 +3        IF +$GET(SCROLL)

               IF (IOSL>($Y+5))

                   FOR 

                       WRITE !

                       IF IOSL<($Y+6)

                           QUIT 

 +4        SET DIR(0)="FO^1:1"

           SET DIR("A")=$SELECT($GET(PROMPT)]"":PROMPT,1:"Press RETURN to continue or '^' to exit")

 +5        SET DIR("?")="Enter '^' to quit present action or '^^' to quit to menu"

 +6        DO ^DIR

           IF $DATA(DIRUT)

               IF (Y="")

                   KILL DIRUT

 +7        SET Y=$SELECT(Y="^":0,Y="^^":0,$DATA(DTOUT):"",Y="":1,1:1_U_Y)

STOPX      QUIT Y