Routine: GMTSDGH

GMTSDGH ; SLC/MKB,KER/NDBI - Patient Hist by admissions ; 02/27/2002

 ;;2.7;Health Summary;**28,49**;Oct 20, 1995

 ; External References

 ;   DBIA    17  ^DGPM("APCA"

 ;   DBIA    17  ^DGPM("ATID1"

 ;   DBIA    17  ^DGPM("ATS"

 ;   DBIA  2929  DSP^A7RHSM

 ;   DBIA  2929  LST^A7RHSM

 ;   DBIA 10061  IN5^VADPT

 ;   DBIA 10061  KVAR^VADPT

MAIN ; Loop through admissions starting from most recent

 N VAHOW

 K VAIP

 I $D(GMTSNDM),GMTSNDM>0 S CNTR=GMTSNDM

 E  S CNTR=100

 S VA200=1,VAHOW=1,FLAG=-1,ADM=GMTS1

 D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) LST^A7RHSM(DFN,.A7RHS)

 F  S ADM=$O(^DGPM("ATID1",DFN,ADM)) D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) DSP^A7RHSM(ADM) Q:('ADM)!(ADM>GMTS2)!(CNTR=0)!('DFN)  D MVTS

 D KILVAR K:$$NDBI^GMTSU A7RHS

MVTS ; Loop through mvts chronologically, per admission

 S ADA=0,ADA=$O(^DGPM("ATID1",DFN,ADM,ADA)) Q:'ADA

 K VAIP,PREVDR,PREVSP,^UTILITY($J)

 S VAIP("E")=ADA D IN5^VADPT

 I $D(VAIP) D CKP^GMTSUP Q:$D(GMTSQIT)  W:FLAG>0 ! D PRNT

 D SETUTL

 S MDM="" F  S MDM=$O(^UTILITY($J,"GMTSMVTS",MDM)) Q:'MDM  D GET

 S CNTR=CNTR-1

GET ; Get Inpatient Data [v5.0 and above]

 I ^UTILITY($J,"GMTSMVTS",MDM)=ADA Q

 K VAIP S VAIP("E")=^UTILITY($J,"GMTSMVTS",MDM) D IN5^VADPT

 I $D(VAIP) D PRNT

PRNT ; Output Data

 S X=+$P(VAIP("MD"),U) D REGDT4^GMTSU

 D CKP^GMTSUP Q:$D(GMTSQIT)

 S DOC=$E($P(VAIP("DR"),U,2),1,10),TYPE=$P(VAIP("MT"),U,2),CODE=+$P(VAIP("TT"),U),SPEC=$E($P(VAIP("TS"),U,2),1,12)

 S TT=$S(CODE=0:"NON",CODE=1:"ADM",CODE=2:"TR ",CODE=3:"DC ",CODE=4:"CIL",CODE=5:"COL",CODE=6:"TS ",1:"   ")

 I 'GMTSNPG,$D(PREVDR),PREVDR=$P(VAIP("DR"),U) S DOC="  "" "

 I 'GMTSNPG,$D(PREVSP),PREVSP=$P(VAIP("TS"),U) S SPEC="    "" "

 W X,?12,TT,"  ",$E(TYPE,1,34),?55,SPEC,?69,DOC,!

 S FLAG=2,PREVDR=$P(VAIP("DR"),U),PREVSP=$P(VAIP("TS"),U)

SETUTL ; Get Treating Specialty and Corresponding Admission

 S (TSDM,MDM)=0

 F  S TSDM=$O(^DGPM("ATS",DFN,ADA,TSDM)) Q:'TSDM  D NEXT1

 F  S MDM=$O(^DGPM("APCA",DFN,ADA,MDM)) Q:'MDM  D NEXT2

NEXT1 ;   Treating Specialty (ATS)

 S TS="",TS=$O(^DGPM("ATS",DFN,ADA,TSDM,TS)) Q:'TS

 S TSDA=0,TSDA=$O(^DGPM("ATS",DFN,ADA,TSDM,TS,TSDA)) Q:'TSDA

 S ^UTILITY($J,"GMTSMVTS",9999999-TSDM)=TSDA

NEXT2 ;   Corresponding Admission (APCA)

 S MDA=0,MDA=$O(^DGPM("APCA",DFN,ADA,MDM,MDA)) Q:'MDA

 I MDA'=ADA S ^UTILITY($J,"GMTSMVTS",MDM)=MDA

KILVAR ; Clean-up, exit

 D KVAR^VADPT

 K FLAG,IN,IM,ADA,ADM,MDA,MDM,X,DOC,CNTR,CODE,TYPE,TT,PREVSP,PREVDR,SPEC

 K ITS,TS,TSDM,TSDA,^UTILITY($J)

GMTSDGH.m