GMTSDGA ; SLC/MKB,KER/NDBI - Admissions for HS ; 03/24/2004
;;2.7;Health Summary;**28,49,71**;Oct 20, 1995
;
; External Reference
; DBIA 3390 $$ICDDX^ICDCODE
; DBIA 17 ^DGPM("ATID"
; DBIA 1372 ^DGPT(
; DBIA 10082 ^ICD9(
; DBIA 2929 DSP^A7RHSM
; DBIA 2929 LST^A7RHSM
; DBIA 512 ^DGPMLOS
; DBIA 10061 IN5^VADPT
; DBIA 10061 KVAR^VADPT
;
ENAD ; Gets Admission Information
S TT=1,FLGDX=0,FLGDC=0
D PATINFO Q
ENDC ; Discharge Information
S TT=3,FLGDC=1,FLGDX=0
D PATINFO Q
ENDX ; PTF Discharge Diagnosis
S TT=3,FLGDX=1,FLGDC=0
D PATINFO Q
ENTS ; Treating Speciality Information
S TT=6,FLGDX=0,FLGDC=0
D PATINFO Q
ENTR ; Transfers
S TT=2,FLGDX=0,FLGDC=0
D PATINFO Q
PATINFO ; Patient Information
S VA200=1 K DIQ
I $D(GMTSNDM),GMTSNDM>0 S CNTR=GMTSNDM
E S CNTR=100
S GMC=-1,GMN="",ADM=GMTS1,FLAG=0
I TT=1 D FADM^GMTSDGA2
D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) LST^A7RHSM(DFN,.A7RHS)
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)
D KILLADM K:$$NDBI^GMTSU A7RHS
Q
GET ; Admission Data
N VAHOW
S ADA=$O(^DGPM("ATID"_TT,DFN,ADM,0)) Q:'ADA
S CNTR=CNTR-1 I CNTR<0 Q
S VAIP("E")=ADA D IN5^VADPT
S (X,ADATE)=+VAIP(3) D REGDT4^GMTSU S ADT=X
K DGPMIFN S:TT=1 DGPMIFN=ADA S:TT'=1 DGPMIFN=VAIP(13)
S GMC=2
D CONTGET
S LIN=$S(TT=2:"TROUT^GMTSDGA1",FLGDX:"DXOUT^GMTSDGA1",FLGDC:"DCOUT^GMTSDGA1",TT=6:"TSOUT^GMTSDGA2",TT=1:"ADOUT^GMTSDGA1") D @LIN
K ICD(ADM)
Q
CONTGET ; ICD and LOS info only needed for certain MAS components
Q:TT=2 Q:TT=6 N ICDX,ICDI I DGPMIFN D ^DGPMLOS S LOS=+X
S PTF=$S($D(VAIP(12)):VAIP(12),1:"") Q:'$D(^ICD9) Q:PTF="" Q:'$D(^DGPT(PTF,70))
S ICD=^DGPT(PTF,70)
S ICDI=+$P(ICD,U,11) I ICDI>0 D
. S ICDX=$$ICDDX^ICDCODE(ICDI)
. S ICD(ADM,1,80,ICDI,.01)=$P(ICDX,"^",2)
. S ICD(ADM,1,80,ICDI,3)=$P(ICDX,"^",4)
S ICDI=+$P(ICD,U,10) I ICDI>0 D
. S ICDX=$$ICDDX^ICDCODE(ICDI)
. S ICD(ADM,2,80,ICDI,.01)=$P(ICDX,"^",2)
. S ICD(ADM,2,80,ICDI,3)=$P(ICDX,"^",4)
F GMTSI=16:1:24 S ICDI=+$P(ICD,U,GMTSI) I ICDI>0 D
. S ICDX=$$ICDDX^ICDCODE(ICDI)
. S ICD(ADM,(GMTSI-13),80,ICDI,.01)=$P(ICDX,"^",2)
. S ICD(ADM,(GMTSI-13),80,ICDI,3)=$P(ICDX,"^",4)
Q
KILLADM ; Kill Admission variables
D KVAR^VADPT
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
Q
GMTSDGA ; SLC/MKB,KER/NDBI - Admissions for HS ; 03/24/2004
+1 ;;2.7;Health Summary;**28,49,71**;Oct 20, 1995
+2 ;
+3 ; External Reference
+4 ; DBIA 3390 $$ICDDX^ICDCODE
+5 ; DBIA 17 ^DGPM("ATID"
+6 ; DBIA 1372 ^DGPT(
+7 ; DBIA 10082 ^ICD9(
+8 ; DBIA 2929 DSP^A7RHSM
+9 ; DBIA 2929 LST^A7RHSM
+10 ; DBIA 512 ^DGPMLOS
+11 ; DBIA 10061 IN5^VADPT
+12 ; DBIA 10061 KVAR^VADPT
+13 ;
ENAD ; Gets Admission Information
+1 SET TT=1
SET FLGDX=0
SET FLGDC=0
+2 DO PATINFO
QUIT
ENDC ; Discharge Information
+1 SET TT=3
SET FLGDC=1
SET FLGDX=0
+2 DO PATINFO
QUIT
ENDX ; PTF Discharge Diagnosis
+1 SET TT=3
SET FLGDX=1
SET FLGDC=0
+2 DO PATINFO
QUIT
ENTS ; Treating Speciality Information
+1 SET TT=6
SET FLGDX=0
SET FLGDC=0
+2 DO PATINFO
QUIT
ENTR ; Transfers
+1 SET TT=2
SET FLGDX=0
SET FLGDC=0
+2 DO PATINFO
QUIT
PATINFO ; Patient Information
+1 SET VA200=1
KILL DIQ
+2 IF $DATA(GMTSNDM)
IF GMTSNDM>0
SET CNTR=GMTSNDM
+3 IF '$TEST
SET CNTR=100
+4 SET GMC=-1
SET GMN=""
SET ADM=GMTS1
SET FLAG=0
+5 IF TT=1
DO FADM^GMTSDGA2
+6 IF $$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU)
DO LST^A7RHSM(DFN,.A7RHS)
+7 FOR
SET ADM=$ORDER(^DGPM("ATID"_TT,DFN,ADM))
IF $$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU)
DO DSP^A7RHSM(ADM)
IF ('ADM!(ADM>GMTS2)!($DATA(GMTSQIT)))
QUIT
DO GET
IF $DATA(GMTSQIT)!($GET(CNTR)<0)
QUIT
+8 DO KILLADM
IF $$NDBI^GMTSU
KILL A7RHS
+9 QUIT
GET ; Admission Data
+1 NEW VAHOW
+2 SET ADA=$ORDER(^DGPM("ATID"_TT,DFN,ADM,0))
IF 'ADA
QUIT
+3 SET CNTR=CNTR-1
IF CNTR<0
QUIT
+4 SET VAIP("E")=ADA
DO IN5^VADPT
+5 SET (X,ADATE)=+VAIP(3)
DO REGDT4^GMTSU
SET ADT=X
+6 KILL DGPMIFN
IF TT=1
SET DGPMIFN=ADA
IF TT'=1
SET DGPMIFN=VAIP(13)
+7 SET GMC=2
+8 DO CONTGET
+9 SET LIN=$SELECT(TT=2:"TROUT^GMTSDGA1",FLGDX:"DXOUT^GMTSDGA1",FLGDC:"DCOUT^GMTSDGA1",TT=6:"TSOUT^GMTSDGA2",TT=1:"ADOUT^GMTSDGA1")
DO @LIN
+10 KILL ICD(ADM)
+11 QUIT
CONTGET ; ICD and LOS info only needed for certain MAS components
+1 IF TT=2
QUIT
IF TT=6
QUIT
NEW ICDX,ICDI
IF DGPMIFN
DO ^DGPMLOS
SET LOS=+X
+2 SET PTF=$SELECT($DATA(VAIP(12)):VAIP(12),1:"")
IF '$DATA(^ICD9)
QUIT
IF PTF=""
QUIT
IF '$DATA(^DGPT(PTF,70))
QUIT
+3 SET ICD=^DGPT(PTF,70)
+4 SET ICDI=+$PIECE(ICD,U,11)
IF ICDI>0
Begin DoDot:1
+5 SET ICDX=$$ICDDX^ICDCODE(ICDI)
+6 SET ICD(ADM,1,80,ICDI,.01)=$PIECE(ICDX,"^",2)
+7 SET ICD(ADM,1,80,ICDI,3)=$PIECE(ICDX,"^",4)
End DoDot:1
+8 SET ICDI=+$PIECE(ICD,U,10)
IF ICDI>0
Begin DoDot:1
+9 SET ICDX=$$ICDDX^ICDCODE(ICDI)
+10 SET ICD(ADM,2,80,ICDI,.01)=$PIECE(ICDX,"^",2)
+11 SET ICD(ADM,2,80,ICDI,3)=$PIECE(ICDX,"^",4)
End DoDot:1
+12 FOR GMTSI=16:1:24
SET ICDI=+$PIECE(ICD,U,GMTSI)
IF ICDI>0
Begin DoDot:1
+13 SET ICDX=$$ICDDX^ICDCODE(ICDI)
+14 SET ICD(ADM,(GMTSI-13),80,ICDI,.01)=$PIECE(ICDX,"^",2)
+15 SET ICD(ADM,(GMTSI-13),80,ICDI,3)=$PIECE(ICDX,"^",4)
End DoDot:1
+16 QUIT
KILLADM ; Kill Admission variables
+1 DO KVAR^VADPT
+2 KILL 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
+3 QUIT
