- 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
