- DGYVPST1 ;ALB/LD - Patch DG*5.3*64 Post-Init (cont.); 8/8/95
- ;;5.3;Registration;**64**;Aug 13, 1993
- ;
- ;
- ;
- ;
- PRTERR ;--Print errors which occurred during pop of file #45.7 Eff Date mult
- N DGPTE,DGPTM,DGPTMSG,DGPTS
- S (DGPTM,DGPTS,DGPTE)=0
- I $E(IOST,1,2)="C-" D HDR
- F S DGPTM=$O(^TMP("DGPTERR",$J,DGPTM)) Q:'DGPTM!($G(DGPTEX)) D
- .F S DGPTS=$O(^TMP("DGPTERR",$J,DGPTM,DGPTS)) Q:'DGPTS!($G(DGPTEX)) D
- ..F S DGPTE=$O(^TMP("DGPTERR",$J,DGPTM,DGPTS,DGPTE)) Q:'DGPTE!($G(DGPTEX)) D
- ...W !,"Specialty: ",$S($P($G(^DIC(42.4,DGPTM,0)),U)]"":$P($G(^DIC(42.4,DGPTM,0)),U),1:"UNKNOWN")
- ...W !,"Facility Treating Specialty: ",$S($P($G(^DIC(45.7,DGPTS,0)),U)]"":$P($G(^DIC(45.7,DGPTS,0)),U),1:"UNKNOWN")
- ...S DGPTMSG=$P($T(ERRMSG+DGPTE),";;",2)
- ...W !,DGPTMSG,!
- ...I $Y>(IOSL-5) D PAUSE Q:$G(DGPTEX) D HDR
- K DGPTEX
- Q
- ;
- PAUSE ;--Pause for screen output
- Q:$E(IOST,1,2)'="C-"
- N XX,DIR,DIRUT,DUOUT
- F XX=$Y:1:(IOSL-3) W !
- S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S DGPTEX=1
- Q
- ;
- HDR ;--Screen header
- W @IOF,?21,"Patch DG*5.3*64 Post-Init Report",!!
- Q
- ;
- ERRMSG ;--Error messages
- ;;Error with entry in file #42.4: Effective Date multiple zero node not found.
- ;;Error with entry in file #42.4: Incomplete Effective Date multiple zero node.
- ;;Error with entry in file #42.4: Missing Effective Date field in multiple.
- ;;Error with entry in file #45.7: Post-init terminated by user.
- ;;Effective Date multiple data already exists for this facility treating spec.
- ;
- INACT ;-- Report of inactive facility treating specialties. These
- ;-- should be edited through the Treating Specialty Set-up option
- ;-- [DG TREATING SETUP] under the ADT System Definition Menu.
- ;
- N DGFAC,DGI,DGJ,DGX,POP
- W !!,">>> Creating Inactive Treating Specialty Report...",! H 2
- F DGI=70,71,77 D
- .F DGJ=0:0 S DGJ=$O(^DIC(45.7,"ASPEC",DGI,DGJ)) Q:'DGJ S DGFAC(DGJ)=DGI_"^"_$P($G(^DIC(45.7,DGJ,0)),U)
- S %ZIS="MP" D ^%ZIS K %ZIS I POP Q
- U IO
- W @IOF,?23,"INACTIVE TREATING SPECIALTY REPORT",!
- W !!?4,"The following facility treating specialties point to treating specialties",!?4,"which are now inactive. These facility treating specialties should be"
- W !?4,"edited to point to active specialties through the Treating Specialty",!?4,"Set-up option [DG TREATING SETUP] under the ADT System Definition Menu.",!!
- W !?8,"FACILITY TREATING SPECIALTY",?46,"INACTIVE TREATING SPECIALTY"
- W !?8,"===========================",?46,"===========================",!
- F DGX=0:0 S DGX=$O(DGFAC(DGX)) Q:'DGX W !?8,$P($G(DGFAC(DGX)),U,2),?46,$P($G(^DIC(42.4,$P($G(DGFAC(DGX)),U),0)),U)
- I '$D(DGFAC) W !?4,"No inactive facility treating specialties found.",!
- D ^%ZISC
- INACTQ Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGYVPST1 2716 printed Jan 18, 2025@04:01:26 Page 2
- DGYVPST1 ;ALB/LD - Patch DG*5.3*64 Post-Init (cont.); 8/8/95
- +1 ;;5.3;Registration;**64**;Aug 13, 1993
- +2 ;
- +3 ;
- +4 ;
- +5 ;
- PRTERR ;--Print errors which occurred during pop of file #45.7 Eff Date mult
- +1 NEW DGPTE,DGPTM,DGPTMSG,DGPTS
- +2 SET (DGPTM,DGPTS,DGPTE)=0
- +3 IF $EXTRACT(IOST,1,2)="C-"
- DO HDR
- +4 FOR
- SET DGPTM=$ORDER(^TMP("DGPTERR",$JOB,DGPTM))
- if 'DGPTM!($GET(DGPTEX))
- QUIT
- Begin DoDot:1
- +5 FOR
- SET DGPTS=$ORDER(^TMP("DGPTERR",$JOB,DGPTM,DGPTS))
- if 'DGPTS!($GET(DGPTEX))
- QUIT
- Begin DoDot:2
- +6 FOR
- SET DGPTE=$ORDER(^TMP("DGPTERR",$JOB,DGPTM,DGPTS,DGPTE))
- if 'DGPTE!($GET(DGPTEX))
- QUIT
- Begin DoDot:3
- +7 WRITE !,"Specialty: ",$SELECT($PIECE($GET(^DIC(42.4,DGPTM,0)),U)]"":$PIECE($GET(^DIC(42.4,DGPTM,0)),U),1:"UNKNOWN")
- +8 WRITE !,"Facility Treating Specialty: ",$SELECT($PIECE($GET(^DIC(45.7,DGPTS,0)),U)]"":$PIECE($GET(^DIC(45.7,DGPTS,0)),U),1:"UNKNOWN")
- +9 SET DGPTMSG=$PIECE($TEXT(ERRMSG+DGPTE),";;",2)
- +10 WRITE !,DGPTMSG,!
- +11 IF $Y>(IOSL-5)
- DO PAUSE
- if $GET(DGPTEX)
- QUIT
- DO HDR
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 KILL DGPTEX
- +13 QUIT
- +14 ;
- PAUSE ;--Pause for screen output
- +1 if $EXTRACT(IOST,1,2)'="C-"
- QUIT
- +2 NEW XX,DIR,DIRUT,DUOUT
- +3 FOR XX=$Y:1:(IOSL-3)
- WRITE !
- +4 SET DIR(0)="E"
- DO ^DIR
- IF $DATA(DIRUT)!($DATA(DUOUT))
- SET DGPTEX=1
- +5 QUIT
- +6 ;
- HDR ;--Screen header
- +1 WRITE @IOF,?21,"Patch DG*5.3*64 Post-Init Report",!!
- +2 QUIT
- +3 ;
- ERRMSG ;--Error messages
- +1 ;;Error with entry in file #42.4: Effective Date multiple zero node not found.
- +2 ;;Error with entry in file #42.4: Incomplete Effective Date multiple zero node.
- +3 ;;Error with entry in file #42.4: Missing Effective Date field in multiple.
- +4 ;;Error with entry in file #45.7: Post-init terminated by user.
- +5 ;;Effective Date multiple data already exists for this facility treating spec.
- +6 ;
- INACT ;-- Report of inactive facility treating specialties. These
- +1 ;-- should be edited through the Treating Specialty Set-up option
- +2 ;-- [DG TREATING SETUP] under the ADT System Definition Menu.
- +3 ;
- +4 NEW DGFAC,DGI,DGJ,DGX,POP
- +5 WRITE !!,">>> Creating Inactive Treating Specialty Report...",!
- HANG 2
- +6 FOR DGI=70,71,77
- Begin DoDot:1
- +7 FOR DGJ=0:0
- SET DGJ=$ORDER(^DIC(45.7,"ASPEC",DGI,DGJ))
- if 'DGJ
- QUIT
- SET DGFAC(DGJ)=DGI_"^"_$PIECE($GET(^DIC(45.7,DGJ,0)),U)
- End DoDot:1
- +8 SET %ZIS="MP"
- DO ^%ZIS
- KILL %ZIS
- IF POP
- QUIT
- +9 USE IO
- +10 WRITE @IOF,?23,"INACTIVE TREATING SPECIALTY REPORT",!
- +11 WRITE !!?4,"The following facility treating specialties point to treating specialties",!?4,"which are now inactive. These facility treating specialties should be"
- +12 WRITE !?4,"edited to point to active specialties through the Treating Specialty",!?4,"Set-up option [DG TREATING SETUP] under the ADT System Definition Menu.",!!
- +13 WRITE !?8,"FACILITY TREATING SPECIALTY",?46,"INACTIVE TREATING SPECIALTY"
- +14 WRITE !?8,"===========================",?46,"===========================",!
- +15 FOR DGX=0:0
- SET DGX=$ORDER(DGFAC(DGX))
- if 'DGX
- QUIT
- WRITE !?8,$PIECE($GET(DGFAC(DGX)),U,2),?46,$PIECE($GET(^DIC(42.4,$PIECE($GET(DGFAC(DGX)),U),0)),U)
- +16 IF '$DATA(DGFAC)
- WRITE !?4,"No inactive facility treating specialties found.",!
- +17 DO ^%ZISC
- INACTQ QUIT