PXCEHLOC ;ISL/dee,ISA/KWP - Creates the List Manager display of visit for a hospital location ;04/30/99
;;1.0;PCE PATIENT CARE ENCOUNTER;**1,52,70,75**;Aug 12, 1996
;; ;
Q
;
MAKELIST ;
K VALMHDR S VALMBCK="R"
;
D CLEAN^VALM10
K ^TMP("PXCEIDX",$J)
D CHGCAP^VALM("LOCATION","Patient")
S VALMBG=1
S VALMCNT=0
I '$D(PXCEHLOC) D
. N PXCEHLOC
. S PXCEHLOC=0
. F S PXCEHLOC=$O(^AUPNVSIT("AHL",PXCEHLOC)) Q:PXCEHLOC'>0 D ONEHLOC
E D ONEHLOC
S ^TMP("PXCEIDX",$J,0)=VALMCNT
I VALMCNT'>0 D
. S ^TMP("PXCE",$J,1,0)=" "
. S ^TMP("PXCE",$J,2,0)=" No encounter found that satisfy the above criteria."
. S VALMCNT=2
Q
;
ONEHLOC ;
N PXCEDATE,PXCELOC,PXCESTAT,PXCEPDFN,PXCEVSIT,PXCENAME,PXCEIEN
N PXCEPRIM,PXELIG,PXDATA
N PXCEDT
S PXCEDT=PXCE9END
N PXCECLST,PXCEGAFR,PXCEGAF,DFN,PXCEMH
S PXCEMH=$$MHCLIN^SDUTL2(PXCEHLOC)
S PXCECLST=$P(^SC(PXCEHLOC,0),"^",7)
F S PXCEDT=$O(^AUPNVSIT("AHL",PXCEHLOC,PXCEDT)) Q:PXCEDT'>0!(PXCEDT>PXCE9BEG) D
. S PXCEIEN=""
. F S PXCEIEN=$O(^AUPNVSIT("AHL",PXCEHLOC,PXCEDT,PXCEIEN)) Q:PXCEIEN'>0 D
.. S PXCEVSIT=^AUPNVSIT(PXCEIEN,0)
.. S PXCEPRIM=$P($G(^AUPNVSIT(PXCEIEN,150)),"^",3)
.. ;+do not show encounter if the encounter type is S,C or null
.. Q:"SC"[PXCEPRIM
.. I PXCEKEYS'["S",PXCEKEYS'["V","A"=PXCEPRIM Q ;+let supervisor and viewer see ancillary package encounters
.. S PXCENAME=$P(PXCEVSIT,"^",5),DFN=PXCENAME,PXCEGAFR=" "
.. I PXCEKEYS'["V",$$DISPOSIT^PXUTL1(PXCENAME,+PXCEVSIT,PXCEIEN) Q ;+let viewer see dispositions
.. S PXELIG=$$ELSTAT^SDUTL2(DFN)
.. S PXDATA=$G(^DPT(DFN,"S",+PXCEVSIT,0))
.. I PXCEMH,'($$COLLAT^SDUTL2(PXELIG)!$P(PXDATA,U,11)) D
... S PXCEGAF=$$NEWGAF^SDUTL2(DFN)
... I $P(PXCEGAF,"^") S PXCEGAFR="*"
.. D PATNAME^PXCEPAT(.PXCENAME)
.. S VALMCNT=VALMCNT+1
.. S PXCEDATE=$$DATE^PXCEDATE($P(PXCEVSIT,"^",1))
.. S PXCEDATE=$E(PXCEDATE,1,18)_$J("",(19-$L(PXCEDATE)))
.. S PXCELOC=$S($P(PXCEVSIT,"^",22)>0:$P(^SC($P(PXCEVSIT,"^",22),0),"^"),1:"")
.. S PXCELOC=$E(PXCELOC,1,26)_$J("",(28-$L(PXCELOC)))
.. S PXCEPDFN=$E(PXCENAME("SSN_BRIEF")_" ",1,5)_$E(PXCENAME("NAME"),1,21)
.. S PXCEPDFN=PXCEPDFN_$J("",(28-$L(PXCEPDFN)))
.. S PXCESTAT=$P($$STATUS^SDPCE(PXCEIEN),"^",2)
.. S ^TMP("PXCE",$J,VALMCNT,0)=PXCEGAFR_$J(VALMCNT,4)_" "_PXCEDATE_PXCEPDFN_PXCESTAT
.. S ^TMP("PXCEIDX",$J,VALMCNT)=PXCEIEN
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEHLOC 2376 printed Apr 09, 2024@21:28:02 Page 2
PXCEHLOC ;ISL/dee,ISA/KWP - Creates the List Manager display of visit for a hospital location ;04/30/99
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,52,70,75**;Aug 12, 1996
+2 ;; ;
+3 QUIT
+4 ;
MAKELIST ;
+1 KILL VALMHDR
SET VALMBCK="R"
+2 ;
+3 DO CLEAN^VALM10
+4 KILL ^TMP("PXCEIDX",$JOB)
+5 DO CHGCAP^VALM("LOCATION","Patient")
+6 SET VALMBG=1
+7 SET VALMCNT=0
+8 IF '$DATA(PXCEHLOC)
Begin DoDot:1
+9 NEW PXCEHLOC
+10 SET PXCEHLOC=0
+11 FOR
SET PXCEHLOC=$ORDER(^AUPNVSIT("AHL",PXCEHLOC))
if PXCEHLOC'>0
QUIT
DO ONEHLOC
End DoDot:1
+12 IF '$TEST
DO ONEHLOC
+13 SET ^TMP("PXCEIDX",$JOB,0)=VALMCNT
+14 IF VALMCNT'>0
Begin DoDot:1
+15 SET ^TMP("PXCE",$JOB,1,0)=" "
+16 SET ^TMP("PXCE",$JOB,2,0)=" No encounter found that satisfy the above criteria."
+17 SET VALMCNT=2
End DoDot:1
+18 QUIT
+19 ;
ONEHLOC ;
+1 NEW PXCEDATE,PXCELOC,PXCESTAT,PXCEPDFN,PXCEVSIT,PXCENAME,PXCEIEN
+2 NEW PXCEPRIM,PXELIG,PXDATA
+3 NEW PXCEDT
+4 SET PXCEDT=PXCE9END
+5 NEW PXCECLST,PXCEGAFR,PXCEGAF,DFN,PXCEMH
+6 SET PXCEMH=$$MHCLIN^SDUTL2(PXCEHLOC)
+7 SET PXCECLST=$PIECE(^SC(PXCEHLOC,0),"^",7)
+8 FOR
SET PXCEDT=$ORDER(^AUPNVSIT("AHL",PXCEHLOC,PXCEDT))
if PXCEDT'>0!(PXCEDT>PXCE9BEG)
QUIT
Begin DoDot:1
+9 SET PXCEIEN=""
+10 FOR
SET PXCEIEN=$ORDER(^AUPNVSIT("AHL",PXCEHLOC,PXCEDT,PXCEIEN))
if PXCEIEN'>0
QUIT
Begin DoDot:2
+11 SET PXCEVSIT=^AUPNVSIT(PXCEIEN,0)
+12 SET PXCEPRIM=$PIECE($GET(^AUPNVSIT(PXCEIEN,150)),"^",3)
+13 ;+do not show encounter if the encounter type is S,C or null
+14 if "SC"[PXCEPRIM
QUIT
+15 ;+let supervisor and viewer see ancillary package encounters
IF PXCEKEYS'["S"
IF PXCEKEYS'["V"
IF "A"=PXCEPRIM
QUIT
+16 SET PXCENAME=$PIECE(PXCEVSIT,"^",5)
SET DFN=PXCENAME
SET PXCEGAFR=" "
+17 ;+let viewer see dispositions
IF PXCEKEYS'["V"
IF $$DISPOSIT^PXUTL1(PXCENAME,+PXCEVSIT,PXCEIEN)
QUIT
+18 SET PXELIG=$$ELSTAT^SDUTL2(DFN)
+19 SET PXDATA=$GET(^DPT(DFN,"S",+PXCEVSIT,0))
+20 IF PXCEMH
IF '($$COLLAT^SDUTL2(PXELIG)!$PIECE(PXDATA,U,11))
Begin DoDot:3
+21 SET PXCEGAF=$$NEWGAF^SDUTL2(DFN)
+22 IF $PIECE(PXCEGAF,"^")
SET PXCEGAFR="*"
End DoDot:3
+23 DO PATNAME^PXCEPAT(.PXCENAME)
+24 SET VALMCNT=VALMCNT+1
+25 SET PXCEDATE=$$DATE^PXCEDATE($PIECE(PXCEVSIT,"^",1))
+26 SET PXCEDATE=$EXTRACT(PXCEDATE,1,18)_$JUSTIFY("",(19-$LENGTH(PXCEDATE)))
+27 SET PXCELOC=$SELECT($PIECE(PXCEVSIT,"^",22)>0:$PIECE(^SC($PIECE(PXCEVSIT,"^",22),0),"^"),1:"")
+28 SET PXCELOC=$EXTRACT(PXCELOC,1,26)_$JUSTIFY("",(28-$LENGTH(PXCELOC)))
+29 SET PXCEPDFN=$EXTRACT(PXCENAME("SSN_BRIEF")_" ",1,5)_$EXTRACT(PXCENAME("NAME"),1,21)
+30 SET PXCEPDFN=PXCEPDFN_$JUSTIFY("",(28-$LENGTH(PXCEPDFN)))
+31 SET PXCESTAT=$PIECE($$STATUS^SDPCE(PXCEIEN),"^",2)
+32 SET ^TMP("PXCE",$JOB,VALMCNT,0)=PXCEGAFR_$JUSTIFY(VALMCNT,4)_" "_PXCEDATE_PXCEPDFN_PXCESTAT
+33 SET ^TMP("PXCEIDX",$JOB,VALMCNT)=PXCEIEN
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
