source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTSUF.m@ 1297

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1DGPTSUF ;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 ;
12EDEFF ;--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
24EDEFFQ K DA,DGDA,DIC,DTOUT,DUOUT,X,Y
25 Q
26EDIT ;--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
35EFFDISP ;--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 ;
48NUMACT(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
Note: See TracBrowser for help on using the repository browser.