| 1 | GMTSDGH ; SLC/MKB,KER/NDBI - Patient Hist by admissions ; 02/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**28,49**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 17 ^DGPM("APCA"
|
|---|
| 6 | ; DBIA 17 ^DGPM("ATID1"
|
|---|
| 7 | ; DBIA 17 ^DGPM("ATS"
|
|---|
| 8 | ; DBIA 2929 DSP^A7RHSM
|
|---|
| 9 | ; DBIA 2929 LST^A7RHSM
|
|---|
| 10 | ; DBIA 10061 IN5^VADPT
|
|---|
| 11 | ; DBIA 10061 KVAR^VADPT
|
|---|
| 12 | ;
|
|---|
| 13 | MAIN ; Loop through admissions starting from most recent
|
|---|
| 14 | N VAHOW
|
|---|
| 15 | K VAIP
|
|---|
| 16 | I $D(GMTSNDM),GMTSNDM>0 S CNTR=GMTSNDM
|
|---|
| 17 | E S CNTR=100
|
|---|
| 18 | S VA200=1,VAHOW=1,FLAG=-1,ADM=GMTS1
|
|---|
| 19 | D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) LST^A7RHSM(DFN,.A7RHS)
|
|---|
| 20 | 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
|
|---|
| 21 | D KILVAR K:$$NDBI^GMTSU A7RHS
|
|---|
| 22 | Q
|
|---|
| 23 | MVTS ; Loop through mvts chronologically, per admission
|
|---|
| 24 | S ADA=0,ADA=$O(^DGPM("ATID1",DFN,ADM,ADA)) Q:'ADA
|
|---|
| 25 | K VAIP,PREVDR,PREVSP,^UTILITY($J)
|
|---|
| 26 | S VAIP("E")=ADA D IN5^VADPT
|
|---|
| 27 | I $D(VAIP) D CKP^GMTSUP Q:$D(GMTSQIT) W:FLAG>0 ! D PRNT
|
|---|
| 28 | D SETUTL
|
|---|
| 29 | S MDM="" F S MDM=$O(^UTILITY($J,"GMTSMVTS",MDM)) Q:'MDM D GET
|
|---|
| 30 | S CNTR=CNTR-1
|
|---|
| 31 | Q
|
|---|
| 32 | GET ; Get Inpatient Data [v5.0 and above]
|
|---|
| 33 | I ^UTILITY($J,"GMTSMVTS",MDM)=ADA Q
|
|---|
| 34 | K VAIP S VAIP("E")=^UTILITY($J,"GMTSMVTS",MDM) D IN5^VADPT
|
|---|
| 35 | I $D(VAIP) D PRNT
|
|---|
| 36 | Q
|
|---|
| 37 | PRNT ; Output Data
|
|---|
| 38 | S X=+$P(VAIP("MD"),U) D REGDT4^GMTSU
|
|---|
| 39 | D CKP^GMTSUP Q:$D(GMTSQIT)
|
|---|
| 40 | 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)
|
|---|
| 41 | 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:" ")
|
|---|
| 42 | I 'GMTSNPG,$D(PREVDR),PREVDR=$P(VAIP("DR"),U) S DOC=" "" "
|
|---|
| 43 | I 'GMTSNPG,$D(PREVSP),PREVSP=$P(VAIP("TS"),U) S SPEC=" "" "
|
|---|
| 44 | W X,?12,TT," ",$E(TYPE,1,34),?55,SPEC,?69,DOC,!
|
|---|
| 45 | S FLAG=2,PREVDR=$P(VAIP("DR"),U),PREVSP=$P(VAIP("TS"),U)
|
|---|
| 46 | Q
|
|---|
| 47 | SETUTL ; Get Treating Specialty and Corresponding Admission
|
|---|
| 48 | S (TSDM,MDM)=0
|
|---|
| 49 | F S TSDM=$O(^DGPM("ATS",DFN,ADA,TSDM)) Q:'TSDM D NEXT1
|
|---|
| 50 | F S MDM=$O(^DGPM("APCA",DFN,ADA,MDM)) Q:'MDM D NEXT2
|
|---|
| 51 | Q
|
|---|
| 52 | NEXT1 ; Treating Specialty (ATS)
|
|---|
| 53 | S TS="",TS=$O(^DGPM("ATS",DFN,ADA,TSDM,TS)) Q:'TS
|
|---|
| 54 | S TSDA=0,TSDA=$O(^DGPM("ATS",DFN,ADA,TSDM,TS,TSDA)) Q:'TSDA
|
|---|
| 55 | S ^UTILITY($J,"GMTSMVTS",9999999-TSDM)=TSDA
|
|---|
| 56 | Q
|
|---|
| 57 | NEXT2 ; Corresponding Admission (APCA)
|
|---|
| 58 | S MDA=0,MDA=$O(^DGPM("APCA",DFN,ADA,MDM,MDA)) Q:'MDA
|
|---|
| 59 | I MDA'=ADA S ^UTILITY($J,"GMTSMVTS",MDM)=MDA
|
|---|
| 60 | Q
|
|---|
| 61 | KILVAR ; Clean-up, exit
|
|---|
| 62 | D KVAR^VADPT
|
|---|
| 63 | K FLAG,IN,IM,ADA,ADM,MDA,MDM,X,DOC,CNTR,CODE,TYPE,TT,PREVSP,PREVDR,SPEC
|
|---|
| 64 | K ITS,TS,TSDM,TSDA,^UTILITY($J)
|
|---|
| 65 | Q
|
|---|
