| 1 | GMTSDGA2 ; SLC/MKB,KER - Treating Spec for HS ; 02/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**28,49**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 17 ^DGPM(
|
|---|
| 6 | ; DBIA 1003 ^DGS(41.1
|
|---|
| 7 | ; DBIA 3145 ^DIC(42.4
|
|---|
| 8 | ; DBIA 3147 ^DIC(45.7
|
|---|
| 9 | ; DBIA 10015 EN^DIQ1 (file 41.1)
|
|---|
| 10 | ; DBIA 10011 ^DIWP
|
|---|
| 11 | ;
|
|---|
| 12 | TSOUT ; Treating Speciality Output
|
|---|
| 13 | S X=+VAIP(13,1) D REGDT4^GMTSU S DDT=X
|
|---|
| 14 | S X=ADATE D MTIM^GMTSU S ADT=ADT_" "_X
|
|---|
| 15 | S TS=$P($G(^DIC(45.7,+VAIP(8),0)),U,2) S SPEC=$S($D(^DIC(42.4,+TS,0)):$P(^(0),U),1:"UNKNOWN")
|
|---|
| 16 | D CKP^GMTSUP Q:$D(GMTSQIT) W ADT,?21,$E(SPEC,1,25),?48,"(",DDT,")",?63,$E($P(VAIP(7),U,2),1,15),!
|
|---|
| 17 | K ^UTILITY($J,"W") I $D(^DGPM(ADA,"DX")) F GMJ=1:1:$P(^DGPM(ADA,"DX",0),"^",4) S X=^DGPM(ADA,"DX",GMJ,0),DIWL=27,DIWR=71,DIWF="C46R" D ^DIWP
|
|---|
| 18 | I $D(^UTILITY($J,"W")) D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,"Diag: " S GMJ=$O(^UTILITY($J,"W",0)) Q:'GMJ S GMJ1=0 F GMZ=0:0 S GMJ1=$O(^UTILITY($J,"W",GMJ,GMJ1)) Q:'GMJ1 D CKP^GMTSUP Q:$D(GMTSQIT) W ?27,^UTILITY($J,"W",GMJ,GMJ1,0),!
|
|---|
| 19 | K DIWL,DIWF,DIWR,^UTILITY($J,"W")
|
|---|
| 20 | Q
|
|---|
| 21 | FADM ; Future Scheduled admission output
|
|---|
| 22 | N GMDT,NODE,X
|
|---|
| 23 | K ^TMP("GMFADM",$J)
|
|---|
| 24 | D GETFADM
|
|---|
| 25 | Q:'$D(^TMP("GMFADM",$J))
|
|---|
| 26 | S GMC=1
|
|---|
| 27 | S GMDT=0
|
|---|
| 28 | F S GMDT=$O(^TMP("GMFADM",$J,GMDT)) Q:GMDT'>0 D
|
|---|
| 29 | . I FLAG>1,'GMTSNPG D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
|---|
| 30 | . D CKP^GMTSUP Q:$D(GMTSQIT)
|
|---|
| 31 | . S FLAG=2
|
|---|
| 32 | . S NODE=$G(^TMP("GMFADM",$J,GMDT))
|
|---|
| 33 | . S X=$P(NODE,U) D REGDT4^GMTSU
|
|---|
| 34 | . D CKP^GMTSUP Q:$D(GMTSQIT) W X," (Future)",?23,$E($P(NODE,U,5),1,24)
|
|---|
| 35 | . I $P(NODE,U,6)>0 W ?49,"Expected LOS: ",$P(NODE,U,6),!
|
|---|
| 36 | . D CKP^GMTSUP Q:$D(GMTSQIT) D
|
|---|
| 37 | . . I $P(NODE,U,2)]"" W "Admitting Diagnosis: ",$P(NODE,U,2)
|
|---|
| 38 | . . W ?51,"Provider: ",$E($P(NODE,U,3),1,15),!
|
|---|
| 39 | K ^TMP("GMFADM",$J)
|
|---|
| 40 | Q
|
|---|
| 41 | GETFADM ; Get future scheduled admission data
|
|---|
| 42 | N DA,DIQ,DIC,DR
|
|---|
| 43 | Q:'$D(^DGS(41.1,"B",DFN))
|
|---|
| 44 | K ^TMP("GMFADM",$J)
|
|---|
| 45 | S DA=0,DIC=41.1,DR="2;3;4;5;6;8;9;10;13;17"
|
|---|
| 46 | F S DA=$O(^DGS(41.1,"B",DFN,DA)) Q:DA'>0 D
|
|---|
| 47 | . N GMFADM,DIQ,RESDT,ADDX,PROV,SUR,LOC,LOS
|
|---|
| 48 | . S DIQ="GMFADM",DIQ(0)="IE"
|
|---|
| 49 | . D EN^DIQ1
|
|---|
| 50 | . ; Quit if reservation day is past,
|
|---|
| 51 | . ; admission cancel or patient admitted
|
|---|
| 52 | . Q:GMFADM(41.1,DA,13,"I")]""!(GMFADM(41.1,DA,17,"I")]"")!(GMFADM(41.1,DA,2,"I")<DT)
|
|---|
| 53 | . S RESDT=GMFADM(41.1,DA,2,"I"),ADDX=GMFADM(41.1,DA,4,"I")
|
|---|
| 54 | . S PROV=GMFADM(41.1,DA,5,"E"),SUR=GMFADM(41.1,DA,6,"E")
|
|---|
| 55 | . ; LOC will contain either ward or treating specialty
|
|---|
| 56 | . S LOC=$S(GMFADM(41.1,DA,10,"I")="W":GMFADM(41.1,DA,8,"E"),GMFADM(41.1,DA,10,"I")="T":GMFADM(41.1,DA,9,"E"),1:"")
|
|---|
| 57 | . S LOS=GMFADM(41.1,DA,3,"I")
|
|---|
| 58 | . S ^TMP("GMFADM",$J,9999999-RESDT)=RESDT_U_ADDX_U_PROV_U_SUR_U_LOC_U_LOS
|
|---|
| 59 | Q
|
|---|
