| [613] | 1 | GMTSDGA1 ; SLC/MKB,KER - Admissions (cont) ; 02/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**28,49**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 17 ^DGPM(
|
|---|
| 6 | ; DBIA 1372 ^DGPT(
|
|---|
| 7 | ; DBIA 10015 EN^DIQ1 (file 45)
|
|---|
| 8 | ; DBIA 3145 ^DIC(42.4,
|
|---|
| 9 | ; DBIA 3147 ^DIC(45.7,
|
|---|
| 10 | ;
|
|---|
| 11 | TROUT ; Transfers Output
|
|---|
| 12 | S X=ADATE D MTIM^GMTSU S TI=X,ADT=ADT_" "_TI
|
|---|
| 13 | D CKP^GMTSUP Q:$D(GMTSQIT) W ADT,?21,$P(VAIP(4),U,2),$S($P(VAIP(4),U,2)'["TO":" TO ",1:" "),$P(VAIP(5),U,2),!
|
|---|
| 14 | S TRFAC=$P(^DGPM(ADA,0),U,5) I $L(TRFAC) D CKP^GMTSUP Q:$D(GMTSQIT) W ?24,TRFAC,! K TRFAC
|
|---|
| 15 | Q
|
|---|
| 16 | DCOUT ; Discharges Output
|
|---|
| 17 | N BDSC,OPTR,DSPL D CKP^GMTSUP Q:$D(GMTSQIT) I VAIP(17)="" S GMC=-1 Q
|
|---|
| 18 | I VAIP(17,1)'="" S X=+VAIP(17,1) D REGDT4^GMTSU W " Date of Discharge: ",X,!
|
|---|
| 19 | I (+$P($G(ICD),U,10)>0),($G(ICD(ADM,2,80,+$P(ICD,U,10),3))]"") D CKP^GMTSUP Q:$D(GMTSQIT) W ?16,"DXLS: ",ICD(ADM,2,80,+$P(ICD,U,10),3),!
|
|---|
| 20 | S PTFLG=$S(PTF="":0,'$D(^DGPT(+PTF,70)):0,1:1),PTF70=$S(PTFLG:^DGPT(+PTF,70),1:"") D BDO
|
|---|
| 21 | D CKP^GMTSUP Q:$D(GMTSQIT) W ?10,"Bedsection: ",BDSC,!
|
|---|
| 22 | I $G(VAIP(17,3))'="" D CKP^GMTSUP Q:$D(GMTSQIT) W " Disposition Type: ",$P(VAIP(17,3),U,2),!
|
|---|
| 23 | D CKP^GMTSUP Q:$D(GMTSQIT) W " Disposition Place: ",DSPL,!
|
|---|
| 24 | D CKP^GMTSUP Q:$D(GMTSQIT) W "Outpatient Treatment: ",OPTR,!
|
|---|
| 25 | I 'GMTSNPG D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
|---|
| 26 | Q
|
|---|
| 27 | BDO ; Bedsection/Disposition/Outpatient Treatment
|
|---|
| 28 | N DIC,DA,DR,DIQ,PTFA S PTF=+($G(PTF)),DIC=45,DA=+PTF,DR="71;73;75;",DIQ="PTFA(" D EN^DIQ1
|
|---|
| 29 | S BDSC=$S($G(PTFA(45,+DA,71))]"":$G(PTFA(45,+DA,71)),1:"UNKNOWN")
|
|---|
| 30 | S OPTR=$S($G(PTFA(45,+DA,73))]"":$G(PTFA(45,+DA,73)),1:"UNKNOWN")
|
|---|
| 31 | S DSPL=$S($G(PTFA(45,+DA,75))]"":$G(PTFA(45,+DA,75)),1:"UNKNOWN")
|
|---|
| 32 | Q
|
|---|
| 33 | DXOUT ; PTF Discharge Diagnosis Output
|
|---|
| 34 | I FLAG>1,'GMTSNPG D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
|---|
| 35 | D CKP^GMTSUP Q:$D(GMTSQIT)
|
|---|
| 36 | S FLAG=2
|
|---|
| 37 | S X=+$G(VAIP(13,1)) D REGDT4^GMTSU S DDT=X
|
|---|
| 38 | W DDT," - ",ADT,?57,"LOS: ",LOS,!
|
|---|
| 39 | S NODIAG=1,GMI=0
|
|---|
| 40 | F S GMI=$O(ICD(ADM,GMI)) Q:'GMI D CKP^GMTSUP Q:$D(GMTSQIT) S GMX="" F S GMX=$O(ICD(ADM,GMI,80,GMX)) Q:'GMX D NXT
|
|---|
| 41 | I NODIAG D CKP^GMTSUP Q:$D(GMTSQIT) W "No discharge diagnosis available for this admission.",! K NODIAG
|
|---|
| 42 | Q
|
|---|
| 43 | ADOUT ; Admissions Output
|
|---|
| 44 | I FLAG>1,'GMTSNPG D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
|---|
| 45 | D CKP^GMTSUP Q:$D(GMTSQIT)
|
|---|
| 46 | S FLAG=2
|
|---|
| 47 | I $G(VAIP(17,1))="" S DDT="Present"
|
|---|
| 48 | E S X=$P(VAIP(17,1),U,1) D REGDT4^GMTSU S DDT=X
|
|---|
| 49 | W ADT," - ",DDT I VAIP(17,1)="" W ?25,GMTSWARD," ",GMTSRB
|
|---|
| 50 | W ?56,"LOS: ",LOS,!
|
|---|
| 51 | S TS=$P($G(^DIC(45.7,+$P($G(VAIP(14,6)),U),0)),U,2) S SPEC=$P($G(^DIC(42.4,+TS,0)),U)
|
|---|
| 52 | D CKP^GMTSUP Q:$D(GMTSQIT) W " Last Tr Specialty: ",$E(SPEC,1,25),?50,"Last Prov: ",$E($P($G(VAIP(14,5)),U,2),1,15),!
|
|---|
| 53 | I $G(VAIP(17,1))="" D CKP^GMTSUP Q:$D(GMTSQIT) W "Admitting Diagnosis: ",$G(VAIP(13,7)),!
|
|---|
| 54 | I PTF'="",$D(^DGPT(+PTF,70)) D CKP^GMTSUP Q:$D(GMTSQIT) W " Bedsection: ",$S(+($P(^DGPT(PTF,70),U,2))>0:$P($G(^DIC(42.4,+$P(^DGPT(PTF,70),U,2),0)),U),1:""),!
|
|---|
| 55 | Q:'$D(ICD) S GMI=0 F S GMI=$O(ICD(ADM,GMI)) Q:'GMI D CKP^GMTSUP Q:$D(GMTSQIT) S GMX="" F S GMX=$O(ICD(ADM,GMI,80,GMX)) Q:'GMX D NXT
|
|---|
| 56 | Q
|
|---|
| 57 | NXT ; Next Diagnosis
|
|---|
| 58 | S (GMTO,GMTNO)="" S GMTO=$G(ICD(ADM,GMI,80,GMX,3)),GMTNO=$G(ICD(ADM,GMI,80,GMX,.01))
|
|---|
| 59 | W:GMI=1 "Principal Diagnosis: " W:GMI=2 ?15,"DXLS: "
|
|---|
| 60 | W:GMI=3 ?13,"ICD DX: " W ?21,GMTO,?62,GMTNO,!
|
|---|
| 61 | S NODIAG=0
|
|---|
| 62 | Q
|
|---|
