source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDGA.m@ 1801

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1GMTSDGA ; SLC/MKB,KER/NDBI - Admissions for HS ; 03/24/2004
2 ;;2.7;Health Summary;**28,49,71**;Oct 20, 1995
3 ;
4 ; External Reference
5 ; DBIA 3390 $$ICDDX^ICDCODE
6 ; DBIA 17 ^DGPM("ATID"
7 ; DBIA 1372 ^DGPT(
8 ; DBIA 10082 ^ICD9(
9 ; DBIA 2929 DSP^A7RHSM
10 ; DBIA 2929 LST^A7RHSM
11 ; DBIA 512 ^DGPMLOS
12 ; DBIA 10061 IN5^VADPT
13 ; DBIA 10061 KVAR^VADPT
14 ;
15ENAD ; Gets Admission Information
16 S TT=1,FLGDX=0,FLGDC=0
17 D PATINFO Q
18ENDC ; Discharge Information
19 S TT=3,FLGDC=1,FLGDX=0
20 D PATINFO Q
21ENDX ; PTF Discharge Diagnosis
22 S TT=3,FLGDX=1,FLGDC=0
23 D PATINFO Q
24ENTS ; Treating Speciality Information
25 S TT=6,FLGDX=0,FLGDC=0
26 D PATINFO Q
27ENTR ; Transfers
28 S TT=2,FLGDX=0,FLGDC=0
29 D PATINFO Q
30PATINFO ; Patient Information
31 S VA200=1 K DIQ
32 I $D(GMTSNDM),GMTSNDM>0 S CNTR=GMTSNDM
33 E S CNTR=100
34 S GMC=-1,GMN="",ADM=GMTS1,FLAG=0
35 I TT=1 D FADM^GMTSDGA2
36 D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) LST^A7RHSM(DFN,.A7RHS)
37 F S ADM=$O(^DGPM("ATID"_TT,DFN,ADM)) D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) DSP^A7RHSM(ADM) Q:('ADM!(ADM>GMTS2)!($D(GMTSQIT))) D GET Q:$D(GMTSQIT)!($G(CNTR)<0)
38 D KILLADM K:$$NDBI^GMTSU A7RHS
39 Q
40GET ; Admission Data
41 N VAHOW
42 S ADA=$O(^DGPM("ATID"_TT,DFN,ADM,0)) Q:'ADA
43 S CNTR=CNTR-1 I CNTR<0 Q
44 S VAIP("E")=ADA D IN5^VADPT
45 S (X,ADATE)=+VAIP(3) D REGDT4^GMTSU S ADT=X
46 K DGPMIFN S:TT=1 DGPMIFN=ADA S:TT'=1 DGPMIFN=VAIP(13)
47 S GMC=2
48 D CONTGET
49 S LIN=$S(TT=2:"TROUT^GMTSDGA1",FLGDX:"DXOUT^GMTSDGA1",FLGDC:"DCOUT^GMTSDGA1",TT=6:"TSOUT^GMTSDGA2",TT=1:"ADOUT^GMTSDGA1") D @LIN
50 K ICD(ADM)
51 Q
52CONTGET ; ICD and LOS info only needed for certain MAS components
53 Q:TT=2 Q:TT=6 N ICDX,ICDI I DGPMIFN D ^DGPMLOS S LOS=+X
54 S PTF=$S($D(VAIP(12)):VAIP(12),1:"") Q:'$D(^ICD9) Q:PTF="" Q:'$D(^DGPT(PTF,70))
55 S ICD=^DGPT(PTF,70)
56 S ICDI=+$P(ICD,U,11) I ICDI>0 D
57 . S ICDX=$$ICDDX^ICDCODE(ICDI)
58 . S ICD(ADM,1,80,ICDI,.01)=$P(ICDX,"^",2)
59 . S ICD(ADM,1,80,ICDI,3)=$P(ICDX,"^",4)
60 S ICDI=+$P(ICD,U,10) I ICDI>0 D
61 . S ICDX=$$ICDDX^ICDCODE(ICDI)
62 . S ICD(ADM,2,80,ICDI,.01)=$P(ICDX,"^",2)
63 . S ICD(ADM,2,80,ICDI,3)=$P(ICDX,"^",4)
64 F GMTSI=16:1:24 S ICDI=+$P(ICD,U,GMTSI) I ICDI>0 D
65 . S ICDX=$$ICDDX^ICDCODE(ICDI)
66 . S ICD(ADM,(GMTSI-13),80,ICDI,.01)=$P(ICDX,"^",2)
67 . S ICD(ADM,(GMTSI-13),80,ICDI,3)=$P(ICDX,"^",4)
68 Q
69KILLADM ; Kill Admission variables
70 D KVAR^VADPT
71 K ADA,ADATE,ADT,BD,BDSC,DA,DIC,DDT,DP,DSPL,GMJ,GMJ1,OP,OPTR,FLAG,FLGDX,FLGDC,X,DR,GMI,GMTO,GMTNO,GMTSI,GMX,ADM,CNTR,GMC,GMZ,GMN,ICD,PTF,PTF70,PTFLG,LOS,II,DGPMIFN,IN,LIN,TI,TT,TS,SPEC
72 Q
Note: See TracBrowser for help on using the repository browser.