- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HUSRU 2259 printed Jan 18, 2025@02:40:20 Page 2
- 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