| 1 | DDSRSEL ;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 | ;
|
|---|
| 5 | PG ;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 | ;
|
|---|
| 29 | GDA ;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 | ;
|
|---|
| 65 | ASKSAVE() ;
|
|---|
| 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 | ;
|
|---|
| 88 | CLRDAT ;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 | ;
|
|---|
| 94 | UNLOCK ;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
|
|---|
