- GMTSDGA ; SLC/MKB,KER/NDBI - Admissions for HS ;06/25/15 15:47
- ;;2.7;Health Summary;**28,49,71,101,111**;Oct 20, 1995;Build 17
- ;
- ; External Reference
- ; ICR 5699 $$ICDDATA^ICDXCODE
- ; ICR 17 ^DGPM("ATID"
- ; ICR 1372 ^DGPT(
- ; ICR 2929 DSP^A7RHSM
- ; ICR 2929 LST^A7RHSM
- ; ICR 512 ^DGPMLOS
- ; ICR 10061 IN5^VADPT
- ; ICR 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
- N GMTSDATE,GMTSTEMP,GMTSTAB S GMTSTEMP="",GMTSTAB=" "
- S PTF=$S($D(VAIP(12)):VAIP(12),1:"") Q:PTF="" Q:'$D(^DGPT(PTF,70))
- S ICD=^DGPT(PTF,70)
- S GMTSDATE=+$P(ICD,U) I $G(GMTSDATE)="" S GMTSDATE=DT
- S ICDI=+$P(ICD,U,11) I ICDI>0 D
- . S ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
- . I $P($G(ICDX),U)=-1 D Q
- .. S ICD(ADM,1,80,ICDI,.01)=$J(" ",38)_$P($G(ICDX),"^",2)
- .. S ICD(ADM,1,80,ICDI,3)=""
- . S ICD(ADM,1,80,ICDI,.01)=GMTSTAB_$P(ICDX,U)_"("_$P(ICDX,U,2)_")"
- . S GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
- . S ICD(ADM,1,80,ICDI,3)=GMTSTEMP
- S ICDI=+$P(ICD,U,10) I ICDI>0 D
- . S ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
- . I $P($G(ICDX),U)=-1 D Q
- .. S ICD(ADM,1,80,ICDI,.01)=$J(" ",38)_$P($G(ICDX),"^",2)
- .. S ICD(ADM,1,80,ICDI,3)=""
- . S ICD(ADM,1,80,ICDI,.01)=GMTSTAB_$P(ICDX,U)_"("_$P(ICDX,U,2)_")"
- . S GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
- . S ICD(ADM,1,80,ICDI,3)=GMTSTEMP
- F GMTSI=16:1:24 S ICDI=+$P(ICD,U,GMTSI) I ICDI>0 D
- . S ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
- . I $P($G(ICDX),U)=-1 D Q
- .. S ICD(ADM,(GMTSI-13),80,ICDI,.01)=$J(" ",38)_$P($G(ICDX),"^",2)
- .. S ICD(ADM,(GMTSI-13),80,ICDI,3)=""
- . S ICD(ADM,(GMTSI-13),80,ICDI,.01)=GMTSTAB_$P(ICDX,U)_"("_$P(ICDX,U,2)_")"
- . S GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
- . S ICD(ADM,(GMTSI-13),80,ICDI,3)=GMTSTEMP
- Q:'$D(^DGPT(PTF,71))
- S ICD=^DGPT(PTF,71)
- F GMTSI=1:1:15 S ICDI=+$P(ICD,U,GMTSI) I ICDI>0 D
- . S ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
- . I $P($G(ICDX),U)=-1 D Q
- .. S ICD(ADM,(GMTSI+11),80,ICDI,.01)=$J(" ",38)_$P($G(ICDX),"^",2)
- .. S ICD(ADM,(GMTSI+11),80,ICDI,3)=""
- . S ICD(ADM,(GMTSI+11),80,ICDI,.01)=GMTSTAB_$P(ICDX,U)_"("_$P(ICDX,U,2)_")"
- . S GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
- . S ICD(ADM,(GMTSI+11),80,ICDI,3)=GMTSTEMP
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSDGA 3680 printed Feb 18, 2025@23:23:41 Page 2
- GMTSDGA ; SLC/MKB,KER/NDBI - Admissions for HS ;06/25/15 15:47
- +1 ;;2.7;Health Summary;**28,49,71,101,111**;Oct 20, 1995;Build 17
- +2 ;
- +3 ; External Reference
- +4 ; ICR 5699 $$ICDDATA^ICDXCODE
- +5 ; ICR 17 ^DGPM("ATID"
- +6 ; ICR 1372 ^DGPT(
- +7 ; ICR 2929 DSP^A7RHSM
- +8 ; ICR 2929 LST^A7RHSM
- +9 ; ICR 512 ^DGPMLOS
- +10 ; ICR 10061 IN5^VADPT
- +11 ; ICR 10061 KVAR^VADPT
- +12 ;
- 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 NEW GMTSDATE,GMTSTEMP,GMTSTAB
- SET GMTSTEMP=""
- SET GMTSTAB=" "
- +3 SET PTF=$SELECT($DATA(VAIP(12)):VAIP(12),1:"")
- if PTF=""
- QUIT
- if '$DATA(^DGPT(PTF,70))
- QUIT
- +4 SET ICD=^DGPT(PTF,70)
- +5 SET GMTSDATE=+$PIECE(ICD,U)
- IF $GET(GMTSDATE)=""
- SET GMTSDATE=DT
- +6 SET ICDI=+$PIECE(ICD,U,11)
- IF ICDI>0
- Begin DoDot:1
- +7 SET ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
- +8 IF $PIECE($GET(ICDX),U)=-1
- Begin DoDot:2
- +9 SET ICD(ADM,1,80,ICDI,.01)=$JUSTIFY(" ",38)_$PIECE($GET(ICDX),"^",2)
- +10 SET ICD(ADM,1,80,ICDI,3)=""
- End DoDot:2
- QUIT
- +11 SET ICD(ADM,1,80,ICDI,.01)=GMTSTAB_$PIECE(ICDX,U)_"("_$PIECE(ICDX,U,2)_")"
- +12 SET GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
- +13 SET ICD(ADM,1,80,ICDI,3)=GMTSTEMP
- End DoDot:1
- +14 SET ICDI=+$PIECE(ICD,U,10)
- IF ICDI>0
- Begin DoDot:1
- +15 SET ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
- +16 IF $PIECE($GET(ICDX),U)=-1
- Begin DoDot:2
- +17 SET ICD(ADM,1,80,ICDI,.01)=$JUSTIFY(" ",38)_$PIECE($GET(ICDX),"^",2)
- +18 SET ICD(ADM,1,80,ICDI,3)=""
- End DoDot:2
- QUIT
- +19 SET ICD(ADM,1,80,ICDI,.01)=GMTSTAB_$PIECE(ICDX,U)_"("_$PIECE(ICDX,U,2)_")"
- +20 SET GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
- +21 SET ICD(ADM,1,80,ICDI,3)=GMTSTEMP
- End DoDot:1
- +22 FOR GMTSI=16:1:24
- SET ICDI=+$PIECE(ICD,U,GMTSI)
- IF ICDI>0
- Begin DoDot:1
- +23 SET ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
- +24 IF $PIECE($GET(ICDX),U)=-1
- Begin DoDot:2
- +25 SET ICD(ADM,(GMTSI-13),80,ICDI,.01)=$JUSTIFY(" ",38)_$PIECE($GET(ICDX),"^",2)
- +26 SET ICD(ADM,(GMTSI-13),80,ICDI,3)=""
- End DoDot:2
- QUIT
- +27 SET ICD(ADM,(GMTSI-13),80,ICDI,.01)=GMTSTAB_$PIECE(ICDX,U)_"("_$PIECE(ICDX,U,2)_")"
- +28 SET GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
- +29 SET ICD(ADM,(GMTSI-13),80,ICDI,3)=GMTSTEMP
- End DoDot:1
- +30 if '$DATA(^DGPT(PTF,71))
- QUIT
- +31 SET ICD=^DGPT(PTF,71)
- +32 FOR GMTSI=1:1:15
- SET ICDI=+$PIECE(ICD,U,GMTSI)
- IF ICDI>0
- Begin DoDot:1
- +33 SET ICDX=$$CODESYS^GMTSPXU1(ICDI,80)
- +34 IF $PIECE($GET(ICDX),U)=-1
- Begin DoDot:2
- +35 SET ICD(ADM,(GMTSI+11),80,ICDI,.01)=$JUSTIFY(" ",38)_$PIECE($GET(ICDX),"^",2)
- +36 SET ICD(ADM,(GMTSI+11),80,ICDI,3)=""
- End DoDot:2
- QUIT
- +37 SET ICD(ADM,(GMTSI+11),80,ICDI,.01)=GMTSTAB_$PIECE(ICDX,U)_"("_$PIECE(ICDX,U,2)_")"
- +38 SET GMTSTEMP=$$VLT^ICDEX(80,ICDI,GMTSDATE)
- +39 SET ICD(ADM,(GMTSI+11),80,ICDI,3)=GMTSTEMP
- End DoDot:1
- +40 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
