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