source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDGH.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1GMTSDGH ; 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 ;
13MAIN ; 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
23MVTS ; 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
32GET ; 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
37PRNT ; 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
47SETUTL ; 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
52NEXT1 ; 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
57NEXT2 ; 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
61KILVAR ; 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
Note: See TracBrowser for help on using the repository browser.