source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDSRSEL.m@ 1710

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1DDSRSEL ;SFISC/MKO-RECORD SELECTION ;08:14 AM 31 Jul 1995
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PG ;Called from:
6 ; DDS01 when user presses SELECT
7 ; FIRSTPG^DDS0 if no DA was passed in.
8 ;
9 ;Returns (if there is a record selection page and we're not in
10 ;a multiple)
11 ; DDSPG = Record selection page #
12 ; DDACT = "NP"
13 ; DDSSEL = 1 (undefined if no record selection page)
14 ;
15 N P,P1 K DDSSEL
16 I $D(DDSSC),$P(DDSSC(DDSSC),U,4) Q
17 ;
18 S P="",P1=$P($G(^DIST(.403,+DDS,21)),U)
19 I P1]"" D
20 . S P=$O(^DIST(.403,+DDS,40,"B",P1,""))
21 . I P]"",$D(^DIST(.403,+DDS,40,P,0))[0 S P=""
22 ;
23 I P]"" D
24 . I $G(DDO),$G(DDSDN)=1 D
25 .. D ERR3^DDS3
26 . E S DDSPG=P,DDACT="NP",DDSSEL=1
27 Q
28 ;
29GDA ;Called from DDS
30 ;After a record selection page is closed get the DA from
31 ;the first field on the page.
32 N DDSANS,DDSREC,Y
33 S DDSANS=""
34 S DDSREC=$$GET^DDSVALF(1,1,$P(^DIST(.403,+DDS,21),U))
35 ;
36 K DA,DDSDAORG
37 S DDSDA=DDSDASV,DDSDL=DDSDLSV
38 D BLDDA^DDS(DDSDA)
39 M DDSDAORG=DDSORGSV
40 ;
41 I 'DDSREC,DA S DDSREC=DA
42 E I DDSREC,DDSREC'=DA D
43 . I DA D Q:DDSREC=DA
44 .. S DDSANS=$$ASKSAVE
45 .. I DDSANS="R" S DDSREC=DA
46 .. E I DDSANS="S" D
47 ... D ^DDS4
48 ... S:Y'=1 DDSREC=DA
49 . ;
50 . S DA=DDSREC
51 . D REC^DDS0(DDP,.DA)
52 . ;
53 . I $G(DIERR) D Q
54 .. D ERR^DDSMSG H 2
55 .. S DA=+$G(DDSDASV),DDACT="N"
56 .. D REC^DDS0(DDP,.DA)
57 . ;
58 . S DDACT="N"
59 . I DDSSC=1 D FRSTPG^DDS0(DDS,.DA,$G(DDSPAGE))
60 . D CLRDAT,UNLOCK
61 ;
62 K DDSSEL,DDSDASV,DDSDASV,DDSDLSV,DDSORGSV
63 Q
64 ;
65ASKSAVE() ;
66 ;Ask user whether to save the previous record
67 N X,Y
68 D:DDM CLRMSG^DDS
69 S DDM=1
70 ;
71 K DIR S DIR(0)="SM^S:SAVE;D:DISCARD;R:RETURN"
72 S DIR("A",1)=" NOTE: You must Save or Discard all edits to the"
73 S DIR("A",2)=" previous record before editing the next record."
74 S DIR("A",3)=" "
75 S DIR("A")="Save, Discard, or Return (S/D/R)"
76 S DIR("B")="SAVE"
77 ;
78 S DIR("?",1)="Enter 'S' to save or 'D' to discard."
79 S DIR("?")="Enter 'R' or '^' to return to previous record."
80 ;
81 S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^7^"_(IOSL-4)_"^0"
82 D ^DIR
83 I $D(DIRUT) S Y="R"
84 E I X="SAVE" S Y="S"
85 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
86 Q Y
87 ;
88CLRDAT ;Clear all data values from @DDSREFT
89 N F,P
90 S P=0 F S P=$O(@DDSREFT@(P)) Q:'P K @DDSREFT@(P)
91 S F="F" F S F=$O(@DDSREFT@(F)) Q:$E(F)'="F" K @DDSREFT@(F)
92 Q
93 ;
94UNLOCK ;Unlock all records locked
95 Q:'$D(^TMP("DDS",$J,"LOCK"))
96 N I S I=""
97 F S I=$O(^TMP("DDS",$J,"LOCK",I)) Q:I="" D
98 . I I'=(DIE_DA_")") L -@I K ^TMP("DDS",$J,"LOCK",I)
99 Q
Note: See TracBrowser for help on using the repository browser.