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