DGPTSUF ;ALB/LD - Utilities for Facility Suffix (#45.68) file; 27 May 1995
;;5.3;Registration;**58**;Aug 13, 1993
;
;--EDEFF called from option 'Add/Edit Suffix Effective Date' (located
; within the Utility submenu of the PTF main menu) to edit and display
; the Effective Date multiple in Facility Suffix (#45.68) file.
;
;--NUMACT called from PTF routines to get the number of active
; suffixes for a station type.
;
;
EDEFF ;--edit effective date multiple in Facility Suffix (#45.68) file
;
N DGSUF
;--lookup to get suffix ien and name
S DIC="^DIC(45.68,",DIC(0)="QEAM",X="?" D ^DIC
I Y=-1!($G(DTOUT))!($G(DUOUT)) G EDEFFQ
S DGDA=+Y,DGSUF=$P($G(Y),U,2)
;--display suffix, effective date, and active flag before editing
D EFFDISP
D EDIT
;--display suffix, effective date, and active flag after editing
D EFFDISP
EDEFFQ K DA,DGDA,DIC,DTOUT,DUOUT,X,Y
Q
EDIT ;--edit effective date; display error msg and loop back if last
; effective date is deleted
N DA,DIE,DR
S DA=DGDA,DIE="^DIC(45.68,",DR="10"
Q:'$G(DA)
L +^DIC(45.68,DGDA):5 I '$T W !!,*7," << RECORD IN USE. TRY AGAIN LATER >>",! G EDEFFQ
D ^DIE
L -^DIC(45.68,DGDA)
Q
EFFDISP ;--display suffix, effective date, and active flag to screen
N DGI,DGJ
S (DGI,DGJ)=0
W !!,"Current Status of Facility Suffix:"
W !!?5,"Facility Suffix",?25,"Effective Date",?45,"Active?"
W !?5,"---------------",?25,"--------------",?45,"-------",!
W ?11,DGSUF
;--get effective date and active flag from multiple
F S DGI=$O(^DIC(45.68,+DGDA,"E","B",DGI)) Q:'DGI D
.F S DGJ=$O(^DIC(45.68,+DGDA,"E","B",DGI,DGJ)) Q:'DGJ D
..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),!
Q
;
NUMACT(STATYP) ; Number of active suffixes for station type
;
; DGEFFDT -- Suffix Effective Date
; DGEFFIEN -- Suffix Effective Date IEN
;
; NOTES: IN: STATYP -- Station Type IEN
; OUT: Number of active suffixes for station type
;
N DGEFFDT,DGEFFIEN,DGI
S DGANUM=0
F DGI=0:0 S DGI=$O(^DIC(45.81,+$G(STATYP),"S","B",DGI)) Q:'DGI D
.S DGEFFDT="",DGEFFDT=+$O(^DIC(45.68,DGI,"E","AEFF",DGEFFDT))
.S DGEFFIEN=0,DGEFFIEN=$O(^DIC(45.68,DGI,"E","AEFF",DGEFFDT,DGEFFIEN))
.I $P($G(^DIC(45.68,DGI,"E",+DGEFFIEN,0)),U,2)=1 D
..S DGANUM=DGANUM+1
..S DGSUFNAM(DGANUM)=$P($G(^DIC(45.68,DGI,0)),U)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTSUF 2467 printed Oct 16, 2024@18:54:14 Page 2
DGPTSUF ;ALB/LD - Utilities for Facility Suffix (#45.68) file; 27 May 1995
+1 ;;5.3;Registration;**58**;Aug 13, 1993
+2 ;
+3 ;--EDEFF called from option 'Add/Edit Suffix Effective Date' (located
+4 ; within the Utility submenu of the PTF main menu) to edit and display
+5 ; the Effective Date multiple in Facility Suffix (#45.68) file.
+6 ;
+7 ;--NUMACT called from PTF routines to get the number of active
+8 ; suffixes for a station type.
+9 ;
+10 ;
EDEFF ;--edit effective date multiple in Facility Suffix (#45.68) file
+1 ;
+2 NEW DGSUF
+3 ;--lookup to get suffix ien and name
+4 SET DIC="^DIC(45.68,"
SET DIC(0)="QEAM"
SET X="?"
DO ^DIC
+5 IF Y=-1!($GET(DTOUT))!($GET(DUOUT))
GOTO EDEFFQ
+6 SET DGDA=+Y
SET DGSUF=$PIECE($GET(Y),U,2)
+7 ;--display suffix, effective date, and active flag before editing
+8 DO EFFDISP
+9 DO EDIT
+10 ;--display suffix, effective date, and active flag after editing
+11 DO EFFDISP
EDEFFQ KILL DA,DGDA,DIC,DTOUT,DUOUT,X,Y
+1 QUIT
EDIT ;--edit effective date; display error msg and loop back if last
+1 ; effective date is deleted
+2 NEW DA,DIE,DR
+3 SET DA=DGDA
SET DIE="^DIC(45.68,"
SET DR="10"
+4 if '$GET(DA)
QUIT
+5 LOCK +^DIC(45.68,DGDA):5
IF '$TEST
WRITE !!,*7," << RECORD IN USE. TRY AGAIN LATER >>",!
GOTO EDEFFQ
+6 DO ^DIE
+7 LOCK -^DIC(45.68,DGDA)
+8 QUIT
EFFDISP ;--display suffix, effective date, and active flag to screen
+1 NEW DGI,DGJ
+2 SET (DGI,DGJ)=0
+3 WRITE !!,"Current Status of Facility Suffix:"
+4 WRITE !!?5,"Facility Suffix",?25,"Effective Date",?45,"Active?"
+5 WRITE !?5,"---------------",?25,"--------------",?45,"-------",!
+6 WRITE ?11,DGSUF
+7 ;--get effective date and active flag from multiple
+8 FOR
SET DGI=$ORDER(^DIC(45.68,+DGDA,"E","B",DGI))
if 'DGI
QUIT
Begin DoDot:1
+9 FOR
SET DGJ=$ORDER(^DIC(45.68,+DGDA,"E","B",DGI,DGJ))
if 'DGJ
QUIT
Begin DoDot:2
+10 WRITE ?28,$$CJ^XLFSTR($$FMTE^XLFDT($PIECE($GET(^DIC(45.68,+DGDA,"E",DGJ,0)),U),"2D"),8),?47,$$RJ^XLFSTR($SELECT($PIECE($GET(^DIC(45.68,+DGDA,"E",DGJ,0)),U,2)=1:"YES",1:"NO"),3),!
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
NUMACT(STATYP) ; Number of active suffixes for station type
+1 ;
+2 ; DGEFFDT -- Suffix Effective Date
+3 ; DGEFFIEN -- Suffix Effective Date IEN
+4 ;
+5 ; NOTES: IN: STATYP -- Station Type IEN
+6 ; OUT: Number of active suffixes for station type
+7 ;
+8 NEW DGEFFDT,DGEFFIEN,DGI
+9 SET DGANUM=0
+10 FOR DGI=0:0
SET DGI=$ORDER(^DIC(45.81,+$GET(STATYP),"S","B",DGI))
if 'DGI
QUIT
Begin DoDot:1
+11 SET DGEFFDT=""
SET DGEFFDT=+$ORDER(^DIC(45.68,DGI,"E","AEFF",DGEFFDT))
+12 SET DGEFFIEN=0
SET DGEFFIEN=$ORDER(^DIC(45.68,DGI,"E","AEFF",DGEFFDT,DGEFFIEN))
+13 IF $PIECE($GET(^DIC(45.68,DGI,"E",+DGEFFIEN,0)),U,2)=1
Begin DoDot:2
+14 SET DGANUM=DGANUM+1
+15 SET DGSUFNAM(DGANUM)=$PIECE($GET(^DIC(45.68,DGI,0)),U)
End DoDot:2
End DoDot:1
+16 QUIT
