- DDSRSEL ;SFISC/MKO-RECORD SELECTION ;08:14 AM 31 Jul 1995
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- PG ;Called from:
- ; DDS01 when user presses SELECT
- ; FIRSTPG^DDS0 if no DA was passed in.
- ;
- ;Returns (if there is a record selection page and we're not in
- ;a multiple)
- ; DDSPG = Record selection page #
- ; DDACT = "NP"
- ; DDSSEL = 1 (undefined if no record selection page)
- ;
- N P,P1 K DDSSEL
- I $D(DDSSC),$P(DDSSC(DDSSC),U,4) Q
- ;
- S P="",P1=$P($G(^DIST(.403,+DDS,21)),U)
- I P1]"" D
- . S P=$O(^DIST(.403,+DDS,40,"B",P1,""))
- . I P]"",$D(^DIST(.403,+DDS,40,P,0))[0 S P=""
- ;
- I P]"" D
- . I $G(DDO),$G(DDSDN)=1 D
- .. D ERR3^DDS3
- . E S DDSPG=P,DDACT="NP",DDSSEL=1
- Q
- ;
- GDA ;Called from DDS
- ;After a record selection page is closed get the DA from
- ;the first field on the page.
- N DDSANS,DDSREC,Y
- S DDSANS=""
- S DDSREC=$$GET^DDSVALF(1,1,$P(^DIST(.403,+DDS,21),U))
- ;
- K DA,DDSDAORG
- S DDSDA=DDSDASV,DDSDL=DDSDLSV
- D BLDDA^DDS(DDSDA)
- M DDSDAORG=DDSORGSV
- ;
- I 'DDSREC,DA S DDSREC=DA
- E I DDSREC,DDSREC'=DA D
- . I DA D Q:DDSREC=DA
- .. S DDSANS=$$ASKSAVE
- .. I DDSANS="R" S DDSREC=DA
- .. E I DDSANS="S" D
- ... D ^DDS4
- ... S:Y'=1 DDSREC=DA
- . ;
- . S DA=DDSREC
- . D REC^DDS0(DDP,.DA)
- . ;
- . I $G(DIERR) D Q
- .. D ERR^DDSMSG H 2
- .. S DA=+$G(DDSDASV),DDACT="N"
- .. D REC^DDS0(DDP,.DA)
- . ;
- . S DDACT="N"
- . I DDSSC=1 D FRSTPG^DDS0(DDS,.DA,$G(DDSPAGE))
- . D CLRDAT,UNLOCK
- ;
- K DDSSEL,DDSDASV,DDSDASV,DDSDLSV,DDSORGSV
- Q
- ;
- ASKSAVE() ;
- ;Ask user whether to save the previous record
- N X,Y
- D:DDM CLRMSG^DDS
- S DDM=1
- ;
- K DIR S DIR(0)="SM^S:SAVE;D:DISCARD;R:RETURN"
- S DIR("A",1)=" NOTE: You must Save or Discard all edits to the"
- S DIR("A",2)=" previous record before editing the next record."
- S DIR("A",3)=" "
- S DIR("A")="Save, Discard, or Return (S/D/R)"
- S DIR("B")="SAVE"
- ;
- S DIR("?",1)="Enter 'S' to save or 'D' to discard."
- S DIR("?")="Enter 'R' or '^' to return to previous record."
- ;
- S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^7^"_(IOSL-4)_"^0"
- D ^DIR
- I $D(DIRUT) S Y="R"
- E I X="SAVE" S Y="S"
- K DIR,DIROUT,DIRUT,DTOUT,DUOUT
- Q Y
- ;
- CLRDAT ;Clear all data values from @DDSREFT
- N F,P
- S P=0 F S P=$O(@DDSREFT@(P)) Q:'P K @DDSREFT@(P)
- S F="F" F S F=$O(@DDSREFT@(F)) Q:$E(F)'="F" K @DDSREFT@(F)
- Q
- ;
- UNLOCK ;Unlock all records locked
- Q:'$D(^TMP("DDS",$J,"LOCK"))
- N I S I=""
- F S I=$O(^TMP("DDS",$J,"LOCK",I)) Q:I="" D
- . I I'=(DIE_DA_")") L -@I K ^TMP("DDS",$J,"LOCK",I)
- Q
- DDSRSEL ;SFISC/MKO-RECORD SELECTION ;08:14 AM 31 Jul 1995
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- PG ;Called from:
- +1 ; DDS01 when user presses SELECT
- +2 ; FIRSTPG^DDS0 if no DA was passed in.
- +3 ;
- +4 ;Returns (if there is a record selection page and we're not in
- +5 ;a multiple)
- +6 ; DDSPG = Record selection page #
- +7 ; DDACT = "NP"
- +8 ; DDSSEL = 1 (undefined if no record selection page)
- +9 ;
- +10 NEW P,P1
- KILL DDSSEL
- +11 IF $DATA(DDSSC)
- IF $PIECE(DDSSC(DDSSC),U,4)
- QUIT
- +12 ;
- +13 SET P=""
- SET P1=$PIECE($GET(^DIST(.403,+DDS,21)),U)
- +14 IF P1]""
- Begin DoDot:1
- +15 SET P=$ORDER(^DIST(.403,+DDS,40,"B",P1,""))
- +16 IF P]""
- IF $DATA(^DIST(.403,+DDS,40,P,0))[0
- SET P=""
- End DoDot:1
- +17 ;
- +18 IF P]""
- Begin DoDot:1
- +19 IF $GET(DDO)
- IF $GET(DDSDN)=1
- Begin DoDot:2
- +20 DO ERR3^DDS3
- End DoDot:2
- +21 IF '$TEST
- SET DDSPG=P
- SET DDACT="NP"
- SET DDSSEL=1
- End DoDot:1
- +22 QUIT
- +23 ;
- GDA ;Called from DDS
- +1 ;After a record selection page is closed get the DA from
- +2 ;the first field on the page.
- +3 NEW DDSANS,DDSREC,Y
- +4 SET DDSANS=""
- +5 SET DDSREC=$$GET^DDSVALF(1,1,$PIECE(^DIST(.403,+DDS,21),U))
- +6 ;
- +7 KILL DA,DDSDAORG
- +8 SET DDSDA=DDSDASV
- SET DDSDL=DDSDLSV
- +9 DO BLDDA^DDS(DDSDA)
- +10 MERGE DDSDAORG=DDSORGSV
- +11 ;
- +12 IF 'DDSREC
- IF DA
- SET DDSREC=DA
- +13 IF '$TEST
- IF DDSREC
- IF DDSREC'=DA
- Begin DoDot:1
- +14 IF DA
- Begin DoDot:2
- +15 SET DDSANS=$$ASKSAVE
- +16 IF DDSANS="R"
- SET DDSREC=DA
- +17 IF '$TEST
- IF DDSANS="S"
- Begin DoDot:3
- +18 DO ^DDS4
- +19 IF Y'=1
- SET DDSREC=DA
- End DoDot:3
- End DoDot:2
- IF DDSREC=DA
- QUIT
- +20 ;
- +21 SET DA=DDSREC
- +22 DO REC^DDS0(DDP,.DA)
- +23 ;
- +24 IF $GET(DIERR)
- Begin DoDot:2
- +25 DO ERR^DDSMSG
- HANG 2
- +26 SET DA=+$GET(DDSDASV)
- SET DDACT="N"
- +27 DO REC^DDS0(DDP,.DA)
- End DoDot:2
- QUIT
- +28 ;
- +29 SET DDACT="N"
- +30 IF DDSSC=1
- DO FRSTPG^DDS0(DDS,.DA,$GET(DDSPAGE))
- +31 DO CLRDAT
- DO UNLOCK
- End DoDot:1
- +32 ;
- +33 KILL DDSSEL,DDSDASV,DDSDASV,DDSDLSV,DDSORGSV
- +34 QUIT
- +35 ;
- ASKSAVE() ;
- +1 ;Ask user whether to save the previous record
- +2 NEW X,Y
- +3 IF DDM
- DO CLRMSG^DDS
- +4 SET DDM=1
- +5 ;
- +6 KILL DIR
- SET DIR(0)="SM^S:SAVE;D:DISCARD;R:RETURN"
- +7 SET DIR("A",1)=" NOTE: You must Save or Discard all edits to the"
- +8 SET DIR("A",2)=" previous record before editing the next record."
- +9 SET DIR("A",3)=" "
- +10 SET DIR("A")="Save, Discard, or Return (S/D/R)"
- +11 SET DIR("B")="SAVE"
- +12 ;
- +13 SET DIR("?",1)="Enter 'S' to save or 'D' to discard."
- +14 SET DIR("?")="Enter 'R' or '^' to return to previous record."
- +15 ;
- +16 SET DIR0=IOSL-1_U_($LENGTH(DIR("A"))+1)_"^7^"_(IOSL-4)_"^0"
- +17 DO ^DIR
- +18 IF $DATA(DIRUT)
- SET Y="R"
- +19 IF '$TEST
- IF X="SAVE"
- SET Y="S"
- +20 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
- +21 QUIT Y
- +22 ;
- CLRDAT ;Clear all data values from @DDSREFT
- +1 NEW F,P
- +2 SET P=0
- FOR
- SET P=$ORDER(@DDSREFT@(P))
- IF 'P
- QUIT
- KILL @DDSREFT@(P)
- +3 SET F="F"
- FOR
- SET F=$ORDER(@DDSREFT@(F))
- IF $EXTRACT(F)'="F"
- QUIT
- KILL @DDSREFT@(F)
- +4 QUIT
- +5 ;
- UNLOCK ;Unlock all records locked
- +1 IF '$DATA(^TMP("DDS",$JOB,"LOCK"))
- QUIT
- +2 NEW I
- SET I=""
- +3 FOR
- SET I=$ORDER(^TMP("DDS",$JOB,"LOCK",I))
- IF I=""
- QUIT
- Begin DoDot:1
- +4 IF I'=(DIE_DA_")")
- LOCK -@I
- KILL ^TMP("DDS",$JOB,"LOCK",I)
- End DoDot:1
- +5 QUIT
