DGTSSET ;ALB/LM - TREATING SPECIALTY SETUP & INITIALIZATION ; 4-1-93
;;5.3;Registration;**27,36,39,64,68,85,242**;Aug 13, 1993
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGTSSET 2588 printed Dec 13, 2024@02:59:04 Page 2
DGTSSET ;ALB/LM - TREATING SPECIALTY SETUP & INITIALIZATION ; 4-1-93
+1 ;;5.3;Registration;**27,36,39,64,68,85,242**;Aug 13, 1993
+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
