source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRU.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1USRU ; SLC/PKR - Utility subroutines for USR ;1/24/00 11:03
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,12,13**;Jun 20, 1997
3 ;======================================================================
4 ;This routine is a direct copy from TIUU.
5READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ; Calls reader, returns response
6 N DIR,X,Y
7 S DIR(0)=TYPE
8 I $D(SCREEN) S DIR("S")=SCREEN
9 I $G(PROMPT)]"" S DIR("A")=PROMPT
10 I $G(DEFAULT)]"" S DIR("B")=DEFAULT
11 I $D(HELP) S DIR("?")=HELP
12 D ^DIR
13 I $G(X)="@" S Y="@" G READX
14 I Y]"",($L($G(Y),U)'=2) S Y=Y_U_$G(Y(0),Y)
15READX Q Y
16 ;
17 ;======================================================================
18 ; MA - CHECK INPUT TRANSFORM 8930.3 (.04) EFFECTIVE DATE > EXP DATE
19VALID(Y) ; USES DA TO FIND RECORD(8930.3)
20 ; Check to verify Expiration date is not less than Effective date
21 I Y=-1 Q 0 ; If ^%DT returns a -1 value date is invalid. Do not Edit.
22 I $P($G(^USR(8930.3,DA,0)),U,3)>Y D Q 0
23 . S X="IORVON;IORVOFF"
24 . D ENDR^%ZISS
25 . S A(1)=IORVON
26 . S A(2)="Can not set Expiration date earlier than Start (Effective) date"
27 . S A(3,"F")="!!"
28 . S A(3)=IORVOFF
29 . D EN^DDIOL(.A)
30 Q 1
31 ;======================================================================
32 ; MA - CHECK INPUT TRANSFORM 8930.3 (.03) EFFECTIVE DATE < EXP DATE
33VALID2(Y) ; USES DA TO FIND RECORD(8930.3)
34 ; Check and verify Effective date is not greater than Expiration
35 I Y=-1 Q 0 ; If ^%DT returns a -1 value date is invalid. Do not Edit.
36 I $P($G(^USR(8930.3,DA,0)),U,4)="" Q 1
37 I $P($G(^USR(8930.3,DA,0)),U,4)<Y D Q 0
38 . S X="IORVON;IORVOFF"
39 . D ENDR^%ZISS
40 . S A(1)=IORVON
41 . S A(2)="Can not set Start (Effective) date later than Expiration date"
42 . S A(3,"F")="!!"
43 . S A(3)=IORVOFF
44 . D EN^DDIOL(.A)
45 . K A
46 Q 1
47 ;======================================================================
48STOP(PROMPT,SCROLL) ; Call DIR at bottom of screen
49 N DIR,X,Y
50 I $E(IOST)'="C" S Y="" G STOPX
51 I +$G(SCROLL),(IOSL>($Y+5)) F W ! Q:IOSL<($Y+6)
52 S DIR(0)="FO^1:1",DIR("A")=$S($G(PROMPT)]"":PROMPT,1:"Press RETURN to continue or '^' to exit")
53 S DIR("?")="Enter '^' to quit present action or '^^' to quit to menu"
54 D ^DIR I $D(DIRUT),(Y="") K DIRUT
55 S Y=$S(Y="^":0,Y="^^":0,$D(DTOUT):"",Y="":1,1:1_U_Y)
56STOPX Q Y
Note: See TracBrowser for help on using the repository browser.