| [613] | 1 | PXCEHLOC ;ISL/dee,ISA/KWP - Creates the List Manager display of visit for a hospital location ;04/30/99
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,52,70,75**;Aug 12, 1996
|
|---|
| 3 | ;; ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | MAKELIST ;
|
|---|
| 7 | K VALMHDR S VALMBCK="R"
|
|---|
| 8 | ;
|
|---|
| 9 | D CLEAN^VALM10
|
|---|
| 10 | K ^TMP("PXCEIDX",$J)
|
|---|
| 11 | D CHGCAP^VALM("LOCATION","Patient")
|
|---|
| 12 | S VALMBG=1
|
|---|
| 13 | S VALMCNT=0
|
|---|
| 14 | I '$D(PXCEHLOC) D
|
|---|
| 15 | . N PXCEHLOC
|
|---|
| 16 | . S PXCEHLOC=0
|
|---|
| 17 | . F S PXCEHLOC=$O(^AUPNVSIT("AHL",PXCEHLOC)) Q:PXCEHLOC'>0 D ONEHLOC
|
|---|
| 18 | E D ONEHLOC
|
|---|
| 19 | S ^TMP("PXCEIDX",$J,0)=VALMCNT
|
|---|
| 20 | I VALMCNT'>0 D
|
|---|
| 21 | . S ^TMP("PXCE",$J,1,0)=" "
|
|---|
| 22 | . S ^TMP("PXCE",$J,2,0)=" No encounter found that satisfy the above criteria."
|
|---|
| 23 | . S VALMCNT=2
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | ONEHLOC ;
|
|---|
| 27 | N PXCEDATE,PXCELOC,PXCESTAT,PXCEPDFN,PXCEVSIT,PXCENAME,PXCEIEN
|
|---|
| 28 | N PXCEPRIM,PXELIG,PXDATA
|
|---|
| 29 | N PXCEDT
|
|---|
| 30 | S PXCEDT=PXCE9END
|
|---|
| 31 | N PXCECLST,PXCEGAFR,PXCEGAF,DFN,PXCEMH
|
|---|
| 32 | S PXCEMH=$$MHCLIN^SDUTL2(PXCEHLOC)
|
|---|
| 33 | S PXCECLST=$P(^SC(PXCEHLOC,0),"^",7)
|
|---|
| 34 | F S PXCEDT=$O(^AUPNVSIT("AHL",PXCEHLOC,PXCEDT)) Q:PXCEDT'>0!(PXCEDT>PXCE9BEG) D
|
|---|
| 35 | . S PXCEIEN=""
|
|---|
| 36 | . F S PXCEIEN=$O(^AUPNVSIT("AHL",PXCEHLOC,PXCEDT,PXCEIEN)) Q:PXCEIEN'>0 D
|
|---|
| 37 | .. S PXCEVSIT=^AUPNVSIT(PXCEIEN,0)
|
|---|
| 38 | .. S PXCEPRIM=$P($G(^AUPNVSIT(PXCEIEN,150)),"^",3)
|
|---|
| 39 | .. ;+do not show encounter if the encounter type is S,C or null
|
|---|
| 40 | .. Q:"SC"[PXCEPRIM
|
|---|
| 41 | .. I PXCEKEYS'["S",PXCEKEYS'["V","A"=PXCEPRIM Q ;+let supervisor and viewer see ancillary package encounters
|
|---|
| 42 | .. S PXCENAME=$P(PXCEVSIT,"^",5),DFN=PXCENAME,PXCEGAFR=" "
|
|---|
| 43 | .. I PXCEKEYS'["V",$$DISPOSIT^PXUTL1(PXCENAME,+PXCEVSIT,PXCEIEN) Q ;+let viewer see dispositions
|
|---|
| 44 | .. S PXELIG=$$ELSTAT^SDUTL2(DFN)
|
|---|
| 45 | .. S PXDATA=$G(^DPT(DFN,"S",+PXCEVSIT,0))
|
|---|
| 46 | .. I PXCEMH,'($$COLLAT^SDUTL2(PXELIG)!$P(PXDATA,U,11)) D
|
|---|
| 47 | ... S PXCEGAF=$$NEWGAF^SDUTL2(DFN)
|
|---|
| 48 | ... I $P(PXCEGAF,"^") S PXCEGAFR="*"
|
|---|
| 49 | .. D PATNAME^PXCEPAT(.PXCENAME)
|
|---|
| 50 | .. S VALMCNT=VALMCNT+1
|
|---|
| 51 | .. S PXCEDATE=$$DATE^PXCEDATE($P(PXCEVSIT,"^",1))
|
|---|
| 52 | .. S PXCEDATE=$E(PXCEDATE,1,18)_$J("",(19-$L(PXCEDATE)))
|
|---|
| 53 | .. S PXCELOC=$S($P(PXCEVSIT,"^",22)>0:$P(^SC($P(PXCEVSIT,"^",22),0),"^"),1:"")
|
|---|
| 54 | .. S PXCELOC=$E(PXCELOC,1,26)_$J("",(28-$L(PXCELOC)))
|
|---|
| 55 | .. S PXCEPDFN=$E(PXCENAME("SSN_BRIEF")_" ",1,5)_$E(PXCENAME("NAME"),1,21)
|
|---|
| 56 | .. S PXCEPDFN=PXCEPDFN_$J("",(28-$L(PXCEPDFN)))
|
|---|
| 57 | .. S PXCESTAT=$P($$STATUS^SDPCE(PXCEIEN),"^",2)
|
|---|
| 58 | .. S ^TMP("PXCE",$J,VALMCNT,0)=PXCEGAFR_$J(VALMCNT,4)_" "_PXCEDATE_PXCEPDFN_PXCESTAT
|
|---|
| 59 | .. S ^TMP("PXCEIDX",$J,VALMCNT)=PXCEIEN
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
