source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCEHLOC.m@ 1446

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1PXCEHLOC ;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 ;
6MAKELIST ;
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 ;
26ONEHLOC ;
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 ;
Note: See TracBrowser for help on using the repository browser.