Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPTSUF

DGPTSUF.m

Go to the documentation of this file.
  1. DGPTSUF ;ALB/LD - Utilities for Facility Suffix (#45.68) file; 27 May 1995
  1. ;;5.3;Registration;**58**;Aug 13, 1993
  1. ;
  1. ;--EDEFF called from option 'Add/Edit Suffix Effective Date' (located
  1. ; within the Utility submenu of the PTF main menu) to edit and display
  1. ; the Effective Date multiple in Facility Suffix (#45.68) file.
  1. ;
  1. ;--NUMACT called from PTF routines to get the number of active
  1. ; suffixes for a station type.
  1. ;
  1. ;
  1. EDEFF ;--edit effective date multiple in Facility Suffix (#45.68) file
  1. ;
  1. N DGSUF
  1. ;--lookup to get suffix ien and name
  1. S DIC="^DIC(45.68,",DIC(0)="QEAM",X="?" D ^DIC
  1. I Y=-1!($G(DTOUT))!($G(DUOUT)) G EDEFFQ
  1. S DGDA=+Y,DGSUF=$P($G(Y),U,2)
  1. ;--display suffix, effective date, and active flag before editing
  1. D EFFDISP
  1. D EDIT
  1. ;--display suffix, effective date, and active flag after editing
  1. D EFFDISP
  1. EDEFFQ K DA,DGDA,DIC,DTOUT,DUOUT,X,Y
  1. Q
  1. EDIT ;--edit effective date; display error msg and loop back if last
  1. ; effective date is deleted
  1. N DA,DIE,DR
  1. S DA=DGDA,DIE="^DIC(45.68,",DR="10"
  1. Q:'$G(DA)
  1. L +^DIC(45.68,DGDA):5 I '$T W !!,*7," << RECORD IN USE. TRY AGAIN LATER >>",! G EDEFFQ
  1. D ^DIE
  1. L -^DIC(45.68,DGDA)
  1. Q
  1. EFFDISP ;--display suffix, effective date, and active flag to screen
  1. N DGI,DGJ
  1. S (DGI,DGJ)=0
  1. W !!,"Current Status of Facility Suffix:"
  1. W !!?5,"Facility Suffix",?25,"Effective Date",?45,"Active?"
  1. W !?5,"---------------",?25,"--------------",?45,"-------",!
  1. W ?11,DGSUF
  1. ;--get effective date and active flag from multiple
  1. F S DGI=$O(^DIC(45.68,+DGDA,"E","B",DGI)) Q:'DGI D
  1. .F S DGJ=$O(^DIC(45.68,+DGDA,"E","B",DGI,DGJ)) Q:'DGJ D
  1. ..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),!
  1. Q
  1. ;
  1. NUMACT(STATYP) ; Number of active suffixes for station type
  1. ;
  1. ; DGEFFDT -- Suffix Effective Date
  1. ; DGEFFIEN -- Suffix Effective Date IEN
  1. ;
  1. ; NOTES: IN: STATYP -- Station Type IEN
  1. ; OUT: Number of active suffixes for station type
  1. ;
  1. N DGEFFDT,DGEFFIEN,DGI
  1. S DGANUM=0
  1. F DGI=0:0 S DGI=$O(^DIC(45.81,+$G(STATYP),"S","B",DGI)) Q:'DGI D
  1. .S DGEFFDT="",DGEFFDT=+$O(^DIC(45.68,DGI,"E","AEFF",DGEFFDT))
  1. .S DGEFFIEN=0,DGEFFIEN=$O(^DIC(45.68,DGI,"E","AEFF",DGEFFDT,DGEFFIEN))
  1. .I $P($G(^DIC(45.68,DGI,"E",+DGEFFIEN,0)),U,2)=1 D
  1. ..S DGANUM=DGANUM+1
  1. ..S DGSUFNAM(DGANUM)=$P($G(^DIC(45.68,DGI,0)),U)
  1. Q