| [613] | 1 | GMTSDGA ; 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 | ;
|
|---|
| 15 | ENAD ; Gets Admission Information
|
|---|
| 16 | S TT=1,FLGDX=0,FLGDC=0
|
|---|
| 17 | D PATINFO Q
|
|---|
| 18 | ENDC ; Discharge Information
|
|---|
| 19 | S TT=3,FLGDC=1,FLGDX=0
|
|---|
| 20 | D PATINFO Q
|
|---|
| 21 | ENDX ; PTF Discharge Diagnosis
|
|---|
| 22 | S TT=3,FLGDX=1,FLGDC=0
|
|---|
| 23 | D PATINFO Q
|
|---|
| 24 | ENTS ; Treating Speciality Information
|
|---|
| 25 | S TT=6,FLGDX=0,FLGDC=0
|
|---|
| 26 | D PATINFO Q
|
|---|
| 27 | ENTR ; Transfers
|
|---|
| 28 | S TT=2,FLGDX=0,FLGDC=0
|
|---|
| 29 | D PATINFO Q
|
|---|
| 30 | PATINFO ; 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
|
|---|
| 40 | GET ; 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
|
|---|
| 52 | CONTGET ; 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
|
|---|
| 69 | KILLADM ; 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
|
|---|
