66 lines
2.4 KiB
Mathematica
66 lines
2.4 KiB
Mathematica
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
|