- 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 Feb 19, 2025@00:19:42 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