1 | DGPTSUF ;ALB/LD - Utilities for Facility Suffix (#45.68) file; 27 May 1995
|
---|
2 | ;;5.3;Registration;**58**;Aug 13, 1993
|
---|
3 | ;
|
---|
4 | ;--EDEFF called from option 'Add/Edit Suffix Effective Date' (located
|
---|
5 | ; within the Utility submenu of the PTF main menu) to edit and display
|
---|
6 | ; the Effective Date multiple in Facility Suffix (#45.68) file.
|
---|
7 | ;
|
---|
8 | ;--NUMACT called from PTF routines to get the number of active
|
---|
9 | ; suffixes for a station type.
|
---|
10 | ;
|
---|
11 | ;
|
---|
12 | EDEFF ;--edit effective date multiple in Facility Suffix (#45.68) file
|
---|
13 | ;
|
---|
14 | N DGSUF
|
---|
15 | ;--lookup to get suffix ien and name
|
---|
16 | S DIC="^DIC(45.68,",DIC(0)="QEAM",X="?" D ^DIC
|
---|
17 | I Y=-1!($G(DTOUT))!($G(DUOUT)) G EDEFFQ
|
---|
18 | S DGDA=+Y,DGSUF=$P($G(Y),U,2)
|
---|
19 | ;--display suffix, effective date, and active flag before editing
|
---|
20 | D EFFDISP
|
---|
21 | D EDIT
|
---|
22 | ;--display suffix, effective date, and active flag after editing
|
---|
23 | D EFFDISP
|
---|
24 | EDEFFQ K DA,DGDA,DIC,DTOUT,DUOUT,X,Y
|
---|
25 | Q
|
---|
26 | EDIT ;--edit effective date; display error msg and loop back if last
|
---|
27 | ; effective date is deleted
|
---|
28 | N DA,DIE,DR
|
---|
29 | S DA=DGDA,DIE="^DIC(45.68,",DR="10"
|
---|
30 | Q:'$G(DA)
|
---|
31 | L +^DIC(45.68,DGDA):5 I '$T W !!,*7," << RECORD IN USE. TRY AGAIN LATER >>",! G EDEFFQ
|
---|
32 | D ^DIE
|
---|
33 | L -^DIC(45.68,DGDA)
|
---|
34 | Q
|
---|
35 | EFFDISP ;--display suffix, effective date, and active flag to screen
|
---|
36 | N DGI,DGJ
|
---|
37 | S (DGI,DGJ)=0
|
---|
38 | W !!,"Current Status of Facility Suffix:"
|
---|
39 | W !!?5,"Facility Suffix",?25,"Effective Date",?45,"Active?"
|
---|
40 | W !?5,"---------------",?25,"--------------",?45,"-------",!
|
---|
41 | W ?11,DGSUF
|
---|
42 | ;--get effective date and active flag from multiple
|
---|
43 | F S DGI=$O(^DIC(45.68,+DGDA,"E","B",DGI)) Q:'DGI D
|
---|
44 | .F S DGJ=$O(^DIC(45.68,+DGDA,"E","B",DGI,DGJ)) Q:'DGJ D
|
---|
45 | ..W ?28,$$CJ^XLFSTR($$FMTE^XLFDT($P($G(^DIC(45.68,+DGDA,"E",DGJ,0)),U),"2D"),8),?47,$$RJ^XLFSTR($S($P($G(^DIC(45.68,+DGDA,"E",DGJ,0)),U,2)=1:"YES",1:"NO"),3),!
|
---|
46 | Q
|
---|
47 | ;
|
---|
48 | NUMACT(STATYP) ; Number of active suffixes for station type
|
---|
49 | ;
|
---|
50 | ; DGEFFDT -- Suffix Effective Date
|
---|
51 | ; DGEFFIEN -- Suffix Effective Date IEN
|
---|
52 | ;
|
---|
53 | ; NOTES: IN: STATYP -- Station Type IEN
|
---|
54 | ; OUT: Number of active suffixes for station type
|
---|
55 | ;
|
---|
56 | N DGEFFDT,DGEFFIEN,DGI
|
---|
57 | S DGANUM=0
|
---|
58 | F DGI=0:0 S DGI=$O(^DIC(45.81,+$G(STATYP),"S","B",DGI)) Q:'DGI D
|
---|
59 | .S DGEFFDT="",DGEFFDT=+$O(^DIC(45.68,DGI,"E","AEFF",DGEFFDT))
|
---|
60 | .S DGEFFIEN=0,DGEFFIEN=$O(^DIC(45.68,DGI,"E","AEFF",DGEFFDT,DGEFFIEN))
|
---|
61 | .I $P($G(^DIC(45.68,DGI,"E",+DGEFFIEN,0)),U,2)=1 D
|
---|
62 | ..S DGANUM=DGANUM+1
|
---|
63 | ..S DGSUFNAM(DGANUM)=$P($G(^DIC(45.68,DGI,0)),U)
|
---|
64 | Q
|
---|