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
 Q
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
 Q
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
 Q
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)
 Q
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
 Q
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
 Q
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
 Q
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)
 Q