1 | GMTSDGCH ; SLC/KER/NDBI - Extended ADT Hist ; 09/21/2001
|
---|
2 | ;;2.7;Health Summary;**28,35,47**;Oct 20, 1995
|
---|
3 | ;
|
---|
4 | ; External References
|
---|
5 | ; DBIA 17 ^DGPM("APCA"
|
---|
6 | ; DBIA 17 ^DGPM("ATID1"
|
---|
7 | ; DBIA 17 ^DGPM("ATS"
|
---|
8 | ; DBIA 10035 ^DPT( fields .01,2,3 Read w/Fileman
|
---|
9 | ; DBIA 2929 DSP^A7RHSM (NDBI)
|
---|
10 | ; DBIA 2929 LST^A7RHSM (NDBI)
|
---|
11 | ; DBIA 10015 EN^DIQ1 (file #2)
|
---|
12 | ; DBIA 10061 ELIG^VADPT
|
---|
13 | ; DBIA 10061 IN5^VADPT
|
---|
14 | ; DBIA 10061 KVAR^VADPT
|
---|
15 | ;
|
---|
16 | MAIN ; Loop through admissions starting from most recent
|
---|
17 | N FLAG,IN,IM,ADA,ADM,MDA,MDM,X,DOC,CNTR,CODE,TYPE,TT,SPEC,ITS,TS,TSDM,TSDA,VAHOW,VA200,GMC,GMMDA,PTF K VAIP
|
---|
18 | S CNTR=$S(+($G(GMTSNDM))>0:GMTSNDM,1:100),VA200=1,VAHOW=1,FLAG=-1,ADM=GMTS1,GMC=0
|
---|
19 | D DISAB,FADM
|
---|
20 | D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) LST^A7RHSM(DFN,.A7RHS)
|
---|
21 | 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
|
---|
22 | . S GMC=0 D MVTS I GMC>0 D
|
---|
23 | . . D ICDP^GMTSDGC2(DFN,+($G(PTF))),ICDS^GMTSDGC2(DFN,+($G(PTF)))
|
---|
24 | D KVAR^VADPT K ^UTILITY($J)
|
---|
25 | K A7RHS
|
---|
26 | Q
|
---|
27 | MVTS ; Loop through mvts chronologically, per admission
|
---|
28 | S ADA=0,ADA=$O(^DGPM("ATID1",DFN,ADM,ADA)) Q:'ADA
|
---|
29 | N VAIP,PREVDR,PREVSP,PREVAP,PREVWD
|
---|
30 | K ^UTILITY($J)
|
---|
31 | S (VAIP("E"),GMMDA)=ADA D IN5^VADPT
|
---|
32 | I $D(VAIP) D CKP^GMTSUP Q:$D(GMTSQIT) W:FLAG>0 ! D PRNT
|
---|
33 | D SETUTL
|
---|
34 | S MDM=""
|
---|
35 | F S MDM=$O(^UTILITY($J,"GMTSMVTS",MDM)) Q:'MDM D GET
|
---|
36 | S CNTR=CNTR-1
|
---|
37 | K ^UTILITY($J)
|
---|
38 | Q
|
---|
39 | GET ; D IN5^VADPT for each mvt, print info
|
---|
40 | I ^UTILITY($J,"GMTSMVTS",MDM)=ADA Q
|
---|
41 | K VAIP
|
---|
42 | S (VAIP("E"),GMMDA)=^UTILITY($J,"GMTSMVTS",MDM) D IN5^VADPT
|
---|
43 | I $D(VAIP) D PRNT
|
---|
44 | Q
|
---|
45 | PRNT ; output line of data
|
---|
46 | S X=+$P(VAIP("MD"),U) D REGDTM4^GMTSU
|
---|
47 | D CKP^GMTSUP Q:$D(GMTSQIT)
|
---|
48 | N DOC,TYPE,CODE,SPEC,ATTN,WARD
|
---|
49 | S DOC=$E($P($G(VAIP("DR")),U,2),1,30),TYPE=$P($G(VAIP("MT")),U,2)
|
---|
50 | S CODE=+$P($G(VAIP("TT")),U),SPEC=$P(VAIP(("TS")),U,2)
|
---|
51 | S PTF=+$G(VAIP("PT"))
|
---|
52 | 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:" ")
|
---|
53 | S GMC=1
|
---|
54 | W X,?18,TT,?23,$E(TYPE,1,56),!
|
---|
55 | I $G(DOC)'=$G(PREVDR)!($G(SPEC)'=$G(PREVSP)) D
|
---|
56 | . N AWS S AWS="Provider/Specialty: "_DOC
|
---|
57 | . W ?3,AWS,?56,SPEC,!
|
---|
58 | . S PREVDR=$G(DOC),PREVSP=$G(SPEC)
|
---|
59 | S ATTN=$P($G(VAIP("AP")),"^",2)
|
---|
60 | S WARD=$P($G(VAIP("WL")),"^",2)
|
---|
61 | I $L(ATTN),($G(ATTN)'=$G(PREVAP)!($G(WARD)'=$G(PREVWD))) D
|
---|
62 | . S AWS="Attending/Ward: "_ATTN
|
---|
63 | . W ?7,AWS,?56,WARD,!
|
---|
64 | . S PREVAP=$G(ATTN),PREVWD=$G(WARD)
|
---|
65 | D OTHER^GMTSDGC1(DFN,PTF,CODE,.VAIP,$G(GMMDA))
|
---|
66 | S FLAG=2
|
---|
67 | Q
|
---|
68 | SETUTL ; Set ^UTILITY array
|
---|
69 | S (TSDM,MDM)=0
|
---|
70 | F S TSDM=$O(^DGPM("ATS",DFN,ADA,TSDM)) Q:'TSDM D NEXT1
|
---|
71 | F S MDM=$O(^DGPM("APCA",DFN,ADA,MDM)) Q:'MDM D NEXT2
|
---|
72 | Q
|
---|
73 | NEXT1 ; Next ^UTILITY($J,"GMTSMVTS",<inverse date>) - "ATS"
|
---|
74 | S TS="",TS=$O(^DGPM("ATS",DFN,ADA,TSDM,TS)) Q:'TS
|
---|
75 | S TSDA=0,TSDA=$O(^DGPM("ATS",DFN,ADA,TSDM,TS,TSDA)) Q:'TSDA
|
---|
76 | S ^UTILITY($J,"GMTSMVTS",9999999-TSDM)=TSDA
|
---|
77 | Q
|
---|
78 | NEXT2 ; Next ^UTILITY($J,"GMTSMVTS",<date>) - "APCA"
|
---|
79 | S MDA=0,MDA=$O(^DGPM("APCA",DFN,ADA,MDM,MDA)) Q:'MDA
|
---|
80 | I MDA'=ADA S ^UTILITY($J,"GMTSMVTS",MDM)=MDA
|
---|
81 | Q
|
---|
82 | DISAB ; Disability Display
|
---|
83 | N GMW,GMTSI,VA,VADM,VAEL,VAERR,VAPA
|
---|
84 | D ELIG^VADPT I +$G(VAEL("EL")) D
|
---|
85 | . S FLAG=2
|
---|
86 | . D CKP^GMTSUP Q:$D(GMTSQIT) W "Eligibility: ",$E($P(VAEL("EL"),U,2),1,40)
|
---|
87 | . W:VAEL("ES")]"" ?56,$P(VAEL("ES"),U,2)
|
---|
88 | . D CKP^GMTSUP Q:$D(GMTSQIT) W:+VAEL("SC") !,"Total S/C %: ",$P(VAEL("SC"),U,2)
|
---|
89 | . I '$D(^DPT(DFN,.372)) D Q
|
---|
90 | . . D CKP^GMTSUP Q:$D(GMTSQIT) W !," No rated disabilities"
|
---|
91 | . S GMTSI=0
|
---|
92 | . F S GMTSI=$O(^DPT(DFN,.372,GMTSI)) Q:GMTSI'>0 D
|
---|
93 | . . N DA,DIQ,DR,DIC,GMTSDIS
|
---|
94 | . . S DIC="^DPT("_DFN_",.372,",DA=GMTSI,DR=".01;2;3",DIQ="GMTSDIS",DIQ(0)="E"
|
---|
95 | . . D EN^DIQ1
|
---|
96 | . . D CKP^GMTSUP Q:$D(GMTSQIT) W !?3,GMTSDIS(2.04,DA,.01,"E"),?51,$J(GMTSDIS(2.04,DA,2,"E"),3),"%",?60,$S(GMTSDIS(2.04,DA,3,"E")="YES":"S/C",1:"NSC")
|
---|
97 | . . D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
98 | Q
|
---|
99 | FADM ; Future Admissions
|
---|
100 | N GMDT,NODE,X
|
---|
101 | K ^TMP("GMFADM",$J)
|
---|
102 | D GETFADM^GMTSDGA2
|
---|
103 | Q:'$D(^TMP("GMFADM",$J))
|
---|
104 | S GMDT=0
|
---|
105 | F S GMDT=$O(^TMP("GMFADM",$J,GMDT)) Q:GMDT'>0 D
|
---|
106 | . S NODE=$G(^TMP("GMFADM",$J,GMDT))
|
---|
107 | . S X=$P(NODE,U) D REGDT4^GMTSU
|
---|
108 | . I FLAG>0 D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
109 | . E S FLAG=2
|
---|
110 | . D CKP^GMTSUP Q:$D(GMTSQIT) W X,?16,"Scheduled Admission",?56,$E($P(NODE,U,5),1,12),?69,$E($P(NODE,U,3),1,10),!
|
---|
111 | . D CKP^GMTSUP Q:$D(GMTSQIT)
|
---|
112 | . I $P(NODE,U,2)]"" W ?11,"Adm. Diag.: ",$P(NODE,U,2)
|
---|
113 | . I $P(NODE,U,6)>0 W ?56,"Expected LOS: ",$P(NODE,U,6),!
|
---|
114 | . D CKP^GMTSUP Q:$D(GMTSQIT)
|
---|
115 | . I $P(NODE,U,4)]"" W ?14,"Surgery: ",$P(NODE,U,4),!
|
---|
116 | K ^TMP("GMFADM",$J)
|
---|
117 | Q
|
---|