source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGTSSET.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1DGTSSET ;ALB/LM - TREATING SPECIALTY SETUP & INITIALIZATION ; 4-1-93
2 ;;5.3;Registration;**27,36,39,64,68,85,242**;Aug 13, 1993
3 ;
4START S DGEGL=+^DG(43,1,"G")\1 ; G&L init date
5 S DGTSDIV=+$P($G(^DG(43,1,"GL")),"^",2) ; Multidivision Med Center
6 ;
7 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
8 ;
9 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
10 ;
11TSR ; Day before TSR Initialiation Date
12 S DGTSIN=$S($D(^DG(43,1,"G")):+$P(^DG(43,1,"G"),"^",11),1:"")
13 ;
14 I DGTSIN'>0 S DGTSIN=2921001
15 S DGTSINDT=$$FMTE^XLFDT(DGTSIN) ; init date - external format
16 S X1=DGTSIN,X2=-1 D C^%DTC S DGTSIN=X ; Internal format of date
17 ;
18 S DGTSDT=$$FMTE^XLFDT(DGTSIN)
19 ;
20FTS ; Facility Treating Specialty File
21 W !
22 S DIC="^DIC(45.7,",DIC(0)="AEQMZL",DLAYGO=45.7 D ^DIC G END:+Y'>0
23 ;
24 ;S DIE=DIC,DA=+Y,DGTS=$P(^DIC(45.7,DA,0),"^"),DR=".01;1;2;10;99" D ^DIE ; DGTS = TS Name
25 S DIE=DIC,(DGTSIEN,DA)=+Y,DGTS=$P(^DIC(45.7,DA,0),"^"),DR="[DGTREAT]" D ^DIE ; DGTS = TS Name
26 ;
27 K DGEGL,DIC,DIE,Y,DA,DR,X,X1,X2
28 ;
29 ; This note was commented out (in patch DG*5.3*39) because it is only
30 ; applicable to the initial setup of existing treating specialties for
31 ; the Treating Specialty report. It does not apply to new
32 ; treating specialties. (RESTORED - PATCH DG*5.3*85)
33 ;
34NOTE ; note to be displayed;
35 W !!?5,"The information for the ",DGTS," treating specialty"
36 W !?5,"should be entered ",$S($D(DGTSDIV):"by Medical Center Division",1:"")," as of midnight on "
37 W !?5,DGTSDT," to properly initialize the Treating Specialty Report!",!!
38 W ?5,"Following any new entries to or revisions of this data, "
39 W !?5,"the G&L MUST BE recalculated back to ",DGTSINDT,".",!!
40 ;
41 W !
42 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
43 ;
44DV ; Medical Center Division File
45 S DIC="^DG(40.8,",DIC(0)="AEQZ"
46 ;
47 I DGTSDIV D ^DIC G FTS:+Y'>0 S (DGTSDV,DA)=+Y
48 ;
49 I 'DGTSDIV S (DGTSDV,DA)=$O(^DG(40.8,0))
50 ;
51C ; Treating Specialty Multiple
52 ; Census Multiple
53 S DIE="^DG(40.8,",DR="[DGTS]" D ^DIE
54 ;
55 K DA,DR,DIE,DIC,Y,X
56 ;
57 I DGTSDIV G DV
58 ;
59 I 'DGTSDIV G FTS
60 ;
61PR ;
62 W !!,"This report should be printed on 132 columns.",!
63 S L=0,DIC="^DIC(45.7,",FLDS="[DGTREAT]",DHD="" D EN1^DIP Q
64 ;
65END K DGEGL,DGTSIN,DGTSDT,DGTSIF,DGTSDV,DGTSDIV,DGTS,DGTSIEN,DGTSPT,DIC,DIE,DA,DR,X,X1,X2 Q
Note: See TracBrowser for help on using the repository browser.