Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXCEAE

PXCEAE.m

Go to the documentation of this file.
  1. PXCEAE ;ISL/dee,ISA/KWP - Main routine for the List Manager display of a visit and related v-files ;11/08/2019
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**37,67,99,147,156,172,195,215,211**;Aug 12, 1996;Build 454
  1. ;; ;
  1. Q
  1. EN ;+ -- main entry point for PXCE DISPLAY VISIT
  1. Q:$G(PXCEVIEN)'>0
  1. ;The selection list for the AICS' package interface used in help messages
  1. N PXCEHLST
  1. ;
  1. N PXCEAEVW S PXCEAEVW="B"
  1. N PXCEVDEL S PXCEVDEL=0
  1. ;
  1. I '$D(PXCEPAT) N PXCEPAT D
  1. . S PXCEPAT=$P($G(^AUPNVSIT(PXCEVIEN,0)),"^",5)
  1. ; next 3 lines PX*1.0*172
  1. N PXREC,PXPTSSN,PXDUZ S PXDUZ=DUZ,PXPTSSN=$P($G(^DPT(PXCEPAT,0)),U,9)
  1. D SEC^PXCEEXP(.PXREC,PXDUZ,PXPTSSN)
  1. I PXREC W !!,"Security regulations prohibit computer access to your own medical record." H 3 Q
  1. S PXCECAT="AEP" D PATINFO^PXCEPAT(.PXCEPAT) K PXCECAT
  1. ;
  1. I '$D(PXCEHLOC) N PXCEHLOC S PXCEHLOC=$P($G(^AUPNVSIT(PXCEVIEN,0)),"^",22)
  1. ;Get Visit date/time if exists - PX*195
  1. I '$D(PXCEAPDT) N PXCEAPDT S PXCEAPDT=$P($G(^AUPNVSIT(PXCEVIEN,0)),"^")
  1. ;If not called from encounter viewer lock the encounter.
  1. I PXCEKEYS'["V" D
  1. .N PXRESVAL,PXVISIEN
  1. . S PXVISIEN=PXCEVIEN
  1. . S PXRESVAL=$$PXCEAE^PXLOCK(PXVISIEN,PXDUZ,1)
  1. . I PXRESVAL=0 Q
  1. . D EN^VALM("PXCE ADD/EDIT MENU")
  1. . D UNLOCK^PXLOCK(PXVISIEN,PXDUZ,"PXCEAE")
  1. I PXCEKEYS["V",$D(^TMP("VALM DATA",$J,VALMEVL,"EXP")),^("EXP")]"" X ^("EXP")
  1. Q
  1. ;
  1. GETVIEN ;Ask the user which visit.
  1. N PXCEVIDX
  1. S PXCEVIDX=+$P(XQORNOD(0),"^",3)
  1. S:PXCEVIDX'>0 PXCEVIDX=$$SEL1^PXCE("")
  1. Q:PXCEVIDX'>0
  1. S PXCEVIEN=$G(^TMP("PXCEIDX",$J,PXCEVIDX))
  1. ;Some encounters can be deleted by Scheduling, called from the PXK
  1. ;VISTA DATA EVENT protocl, so check that the encounter exists.
  1. I '$D(^AUPNVSIT(PXCEVIEN)) D Q
  1. . D FULL^VALM1
  1. . W !,"This encounter has been deleted by a background process." H 2
  1. . D EXIT^PXCEAE
  1. ;Check that it is not related to a no show or canceled apppointment
  1. D APPCHECK^PXCESDAM(.PXCEVIEN)
  1. Q:'$D(PXCEVIEN)
  1. ;Cannot edit future visits
  1. I $P(+^AUPNVSIT(PXCEVIEN,0),".")>DT D Q
  1. . W !!,$C(7),"Can not update future encounters."
  1. . D WAIT^PXCEHELP
  1. . K PXCEVIEN
  1. ;Check if the visit can be associated with an appointment.
  1. S PXCEAPPM=$G(^DPT($P(^AUPNVSIT(PXCEVIEN,0),"^",5),"S",+^AUPNVSIT(PXCEVIEN,0),0))
  1. I $P(PXCEVIEN,"^",7)="E" D I 'Y K PXCEVIEN Q
  1. . W !!,"This is a historical encounter for documenting a clinical encounter only"
  1. . W !,"and will not be used by Scheduling, Billing or Workload credit."
  1. . D PAUSE^PXCEHELP
  1. Q
  1. ;
  1. HDR ; -- header code
  1. I '$D(^AUPNVSIT(PXCEVIEN,0)) S VALMQUIT=1 Q
  1. K VALMHDR
  1. N VISIT0
  1. ;
  1. ;PATIENT
  1. S VISIT0=^AUPNVSIT(PXCEVIEN,0)
  1. S VALMHDR(1)=$E(PXCEPAT("NAME"),1,26)
  1. S VALMHDR(1)=$E(VALMHDR(1)_$E(" ",1,(27-$L(VALMHDR(1))))_PXCEPAT("SSN")_" ",1,40)
  1. S VALMHDR(1)=VALMHDR(1)_"Clinic: "_$S($P(VISIT0,"^",22)>0:$P(^SC($P(VISIT0,"^",22),0),"^"),1:"")
  1. ;
  1. ;DATE
  1. S VALMHDR(2)=$E("Encounter Date "_$S($P(VISIT0,"^",1)>0:$$DATE^PXCEDATE($P(VISIT0,"^",1)),1:"")_" ",1,40)
  1. S VALMHDR(2)=VALMHDR(2)_"Clinic Stop: "_$S($P(VISIT0,"^",8)>0:$$DISPLY08^PXCECSTP($P(VISIT0,"^",8)),1:"")
  1. ;
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. ;
  1. Q
  1. ;
  1. KEYS(PXCEPROT,PXCEEND) ;Set up ^XQORM("KEY") array so that can edit an item by having its
  1. ; number be and action to edit it.
  1. N PXCEPIEN,PXCEINDX
  1. S PXCEPIEN=$O(^ORD(101,"B",PXCEPROT,0))_"^1"
  1. F PXCEINDX=1:1:PXCEEND S XQORM("KEY",PXCEINDX)=PXCEPIEN
  1. ;
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. D BUILD^PXCEAE1(PXCEVIEN,PXCEAEVW,"^TMP(""PXCEAE"",$J)","^TMP(""PXCEAEIX"",$J)")
  1. I '$D(VALMBCK) K VALMHDR S VALMBCK="R"
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. ;
  1. ;Check for incomplete ENCOUNTER if not already removed.
  1. N PXQUIT
  1. S PXQUIT=1
  1. D:'$G(PXCEEXIT) CHECK^PXCEVFI5
  1. ;
  1. D CLEAN^VALM10
  1. K ^TMP("PXCEAE",$J),^TMP("PXCEAEIX",$J)
  1. ;If the Visit does not exist do not firs the protocol event.
  1. I $D(^AUPNVSIT(PXCEVIEN)) D EVENT^PXKMAIN
  1. K PXCEVIEN,PXCEAPPM
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. S PXCEAEVW=$S(PXCEAEVW="B":"D",1:"B")
  1. D BUILD^PXCEAE1(PXCEVIEN,PXCEAEVW,"^TMP(""PXCEAE"",$J)","^TMP(""PXCEAEIX"",$J)")
  1. D DONE^PXCE
  1. Q
  1. ;
  1. EDIT ; -- edit a V-File entry
  1. N PXCEFIDX
  1. S PXCEFIDX=+$P(XQORNOD(0),"^",3)
  1. D DOMANY(PXCEFIDX,"E","EN^PXCEVFIL(PXCECAT)")
  1. Q
  1. ;
  1. DEL ; -- delete a V-File entries
  1. I PXCEKEYS'["D",PXCEKEYS'["d" W !!!,$C(7),"Error: You do not have delete access." D WAIT^PXCEHELP Q
  1. D DOMANY(0,"D","DEL^PXCEVFI2(PXCECAT)")
  1. Q
  1. ;
  1. DOMANY(PXCEFIDX,WHATDO,WHATTODO) ;Process one or more V-File entries
  1. ;WHATDO is E for edit and D for delete
  1. ;WHATTODO is the routine to call
  1. ;
  1. I WHATDO="D" N PXCEDELV S PXCEDELV=0
  1. D FULL^VALM1
  1. I WHATDO="E" D
  1. . S:PXCEFIDX'>0 PXCEFIDX=$$SEL^PXCEAE2("Edit",1)
  1. E I WHATDO="D" D
  1. . S:PXCEFIDX'>0 PXCEFIDX=$$SEL^PXCEAE2("Delete",2)
  1. E W "??",$C(7) Q
  1. Q:+PXCEFIDX'>0
  1. N PXCEINDX,PXCEFIX1,PXCEFIX2
  1. F PXCEINDX=1:1 S PXCEFIX1=$P(PXCEFIDX,",",PXCEINDX) Q:PXCEFIX1']"" D
  1. . I $L(PXCEFIX1,"-")=1 D
  1. .. I WHATDO="D",PXCEFIX1=1 S PXCEDELV=1
  1. .. E D DO1(PXCEFIX1,WHATDO,WHATTODO)
  1. . E F PXCEFIX2=$P(PXCEFIX1,"-",1):1:$P(PXCEFIX1,"-",2) D
  1. .. I WHATDO="D",PXCEFIX2=1 S PXCEDELV=1
  1. .. E D DO1(PXCEFIX2,WHATDO,WHATTODO)
  1. I WHATDO="D",PXCEDELV D DO1(1,WHATDO,WHATTODO)
  1. D INIT
  1. Q
  1. ;
  1. DO1(PXCEFIDX,WHATDO,WHATTODO) ;Process one V-File entry
  1. ;PXCEFIDX is and index into ^TMP("PXCEAEIX",$J, which tells the V-File
  1. ; and the IEN to process
  1. ;WHATDO is E for edit and D for delete
  1. ;WHATTODO is the routine to call
  1. ;
  1. N PXCEONE,PXCECAT,PXCEFIEN
  1. S PXCEONE=$G(^TMP("PXCEAEIX",$J,PXCEFIDX))
  1. S PXCEFIEN=+PXCEONE
  1. S PXCECAT=$P(PXCEONE,"^",2)
  1. I PXCECAT="CSTP",WHATDO="E" W !!!,$C(7),"You cannot edit stop codes." S PXCENOER=1 D WAIT^PXCEHELP Q
  1. I PXCECAT="VST",$P(^AUPNVSIT(PXCEFIEN,0),"^",7)="E" S PXCECAT="HIST"
  1. D @$S("~VST~HIST~CSTP~CPT~IMM~PED~POV~PRV~SK~TRT~HF~XAM~ICR~SC~"[("~"_PXCECAT_"~"):WHATTODO,1:"QUIT") ; PX*1*215
  1. Q
  1. ;
  1. QUIT Q
  1. ;