- 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
- ;
- 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 ;
