DGTSSET.m

DGTSSET ;ALB/LM - TREATING SPECIALTY SETUP & INITIALIZATION ; 4-1-93

 ;;5.3;Registration;**27,36,39,64,68,85,242,1015**;Aug 13, 1993;Build 21

 ;

START S DGEGL=+^DG(43,1,"G")\1 ; G&L init date

 S DGTSDIV=+$P($G(^DG(43,1,"GL")),"^",2) ; Multidivision Med Center

 ;

 I DGEGL'?7N W !!,"I cannot run this program until you specify an early date",!,"to run the G&L in the site parameters.",!!,*7,*7 G END

 ;

 S DGEGL=$O(^DG(40.8,0)) I '$D(^DG(40.8,DGEGL)) W !!,"I cannot run this program until you set up your Medical Center's",!,"Division File",!!,*7,*7 G END

 ;

TSR ; Day before TSR Initialiation Date

 S DGTSIN=$S($D(^DG(43,1,"G")):+$P(^DG(43,1,"G"),"^",11),1:"")

 ;

 I DGTSIN'>0 S DGTSIN=2921001

 S DGTSINDT=$$FMTE^XLFDT(DGTSIN) ; init date - external format

 S X1=DGTSIN,X2=-1 D C^%DTC S DGTSIN=X ; Internal format of date

 ;

 S DGTSDT=$$FMTE^XLFDT(DGTSIN)

 ;

FTS ; Facility Treating Specialty File

 W !

 S DIC="^DIC(45.7,",DIC(0)="AEQMZL",DLAYGO=45.7 D ^DIC G END:+Y'>0

 ;

 ;S DIE=DIC,DA=+Y,DGTS=$P(^DIC(45.7,DA,0),"^"),DR=".01;1;2;10;99" D ^DIE ; DGTS = TS Name

 S DIE=DIC,(DGTSIEN,DA)=+Y,DGTS=$P(^DIC(45.7,DA,0),"^"),DR="[DGTREAT]" D ^DIE ; DGTS = TS Name

 ;

 K DGEGL,DIC,DIE,Y,DA,DR,X,X1,X2

 ;

 ; This note was commented out (in patch DG*5.3*39) because it is only

 ; applicable to the initial setup of existing treating specialties for

 ; the Treating Specialty report.  It does not apply to new

 ; treating specialties.  (RESTORED - PATCH DG*5.3*85)

 ;

NOTE ; note to be displayed;

 W !!?5,"The information for the ",DGTS," treating specialty"

 W !?5,"should be entered ",$S($D(DGTSDIV):"by Medical Center Division",1:"")," as of midnight on "

 W !?5,DGTSDT," to properly initialize the Treating Specialty Report!",!!

 W ?5,"Following any new entries to or revisions of this data, "

 W !?5,"the G&L MUST BE recalculated back to ",DGTSINDT,".",!!

 ;

 W !

 S DGTSIF=$S($D(^DIC(45.7,"B",DGTS)):$O(^DIC(45.7,"B",DGTS,0)),1:-1) ; TS Internal Format (IEN) of Facility Treating Specialty

 ;

DV ; Medical Center Division File

 S DIC="^DG(40.8,",DIC(0)="AEQZ"

 ;

 I DGTSDIV D ^DIC G FTS:+Y'>0 S (DGTSDV,DA)=+Y

 ;

 I 'DGTSDIV S (DGTSDV,DA)=$O(^DG(40.8,0))

 ;

C ;    Treating Specialty Multiple

 ;         Census Multiple

 S DIE="^DG(40.8,",DR="[DGTS]" D ^DIE

 ;

 K DA,DR,DIE,DIC,Y,X

 ;

 I DGTSDIV G DV

 ;

 I 'DGTSDIV G FTS

 ;

PR ;

 W !!,"This report should be printed on 132 columns.",!

 S L=0,DIC="^DIC(45.7,",FLDS="[DGTREAT]",DHD="" D EN1^DIP Q

 ;

END K DGEGL,DGTSIN,DGTSDT,DGTSIF,DGTSDV,DGTSDIV,DGTS,DGTSIEN,DGTSPT,DIC,DIE,DA,DR,X,X1,X2 Q

DGTSSET   ;ALB/LM - TREATING SPECIALTY SETUP & INITIALIZATION ; 4-1-93

 +1       ;;5.3;Registration;**27,36,39,64,68,85,242,1015**;Aug 13, 1993;Build 21

 +2       ;

START     ; G&L init date

           SET DGEGL=+^DG(43,1,"G")\1

 +1       ; Multidivision Med Center

           SET DGTSDIV=+$PIECE($GET(^DG(43,1,"GL")),"^",2)

 +2       ;

 +3        IF DGEGL'?7N

               WRITE !!,"I cannot run this program until you specify an early date",!,"to run the G&L in the site parameters.",!!,*7,*7

               GOTO END

 +4       ;

 +5        SET DGEGL=$ORDER(^DG(40.8,0))

           IF '$DATA(^DG(40.8,DGEGL))

               WRITE !!,"I cannot run this program until you set up your Medical Center's",!,"Division File",!!,*7,*7

               GOTO END

 +6       ;

TSR       ; Day before TSR Initialiation Date

 +1        SET DGTSIN=$SELECT($DATA(^DG(43,1,"G")):+$PIECE(^DG(43,1,"G"),"^",11),1:"")

 +2       ;

 +3        IF DGTSIN'>0

               SET DGTSIN=2921001

 +4       ; init date - external format

           SET DGTSINDT=$$FMTE^XLFDT(DGTSIN)

 +5       ; Internal format of date

           SET X1=DGTSIN

           SET X2=-1

           DO C^%DTC

           SET DGTSIN=X

 +6       ;

 +7        SET DGTSDT=$$FMTE^XLFDT(DGTSIN)

 +8       ;

FTS       ; Facility Treating Specialty File

 +1        WRITE !

 +2        SET DIC="^DIC(45.7,"

           SET DIC(0)="AEQMZL"

           SET DLAYGO=45.7

           DO ^DIC

           IF +Y'>0

               GOTO END

 +3       ;

 +4       ;S DIE=DIC,DA=+Y,DGTS=$P(^DIC(45.7,DA,0),"^"),DR=".01;1;2;10;99" D ^DIE ; DGTS = TS Name

 +5       ; DGTS = TS Name

           SET DIE=DIC

           SET (DGTSIEN,DA)=+Y

           SET DGTS=$PIECE(^DIC(45.7,DA,0),"^")

           SET DR="[DGTREAT]"

           DO ^DIE

 +6       ;

 +7        KILL DGEGL,DIC,DIE,Y,DA,DR,X,X1,X2

 +8       ;

 +9       ; This note was commented out (in patch DG*5.3*39) because it is only

 +10      ; applicable to the initial setup of existing treating specialties for

 +11      ; the Treating Specialty report.  It does not apply to new

 +12      ; treating specialties.  (RESTORED - PATCH DG*5.3*85)

 +13      ;

NOTE      ; note to be displayed;

 +1        WRITE !!?5,"The information for the ",DGTS," treating specialty"

 +2        WRITE !?5,"should be entered ",$SELECT($DATA(DGTSDIV):"by Medical Center Division",1:"")," as of midnight on "

 +3        WRITE !?5,DGTSDT," to properly initialize the Treating Specialty Report!",!!

 +4        WRITE ?5,"Following any new entries to or revisions of this data, "

 +5        WRITE !?5,"the G&L MUST BE recalculated back to ",DGTSINDT,".",!!

 +6       ;

 +7        WRITE !

 +8       ; TS Internal Format (IEN) of Facility Treating Specialty

           SET DGTSIF=$SELECT($DATA(^DIC(45.7,"B",DGTS)):$ORDER(^DIC(45.7,"B",DGTS,0)),1:-1)

 +9       ;

DV        ; Medical Center Division File

 +1        SET DIC="^DG(40.8,"

           SET DIC(0)="AEQZ"

 +2       ;

 +3        IF DGTSDIV

               DO ^DIC

               IF +Y'>0

                   GOTO FTS

               SET (DGTSDV,DA)=+Y

 +4       ;

 +5        IF 'DGTSDIV

               SET (DGTSDV,DA)=$ORDER(^DG(40.8,0))

 +6       ;

C         ;    Treating Specialty Multiple

 +1       ;         Census Multiple

 +2        SET DIE="^DG(40.8,"

           SET DR="[DGTS]"

           DO ^DIE

 +3       ;

 +4        KILL DA,DR,DIE,DIC,Y,X

 +5       ;

 +6        IF DGTSDIV

               GOTO DV

 +7       ;

 +8        IF 'DGTSDIV

               GOTO FTS

 +9       ;

PR        ;

 +1        WRITE !!,"This report should be printed on 132 columns.",!

 +2        SET L=0

           SET DIC="^DIC(45.7,"

           SET FLDS="[DGTREAT]"

           SET DHD=""

           DO EN1^DIP

           QUIT 

 +3       ;

END        KILL DGEGL,DGTSIN,DGTSDT,DGTSIF,DGTSDV,DGTSDIV,DGTS,DGTSIEN,DGTSPT,DIC,DIE,DA,DR,X,X1,X2

           QUIT