PXCEAE ;ISL/dee,ISA/KWP - Main routine for the List Manager display of a visit and related v-files ;04/26/99
;;1.0;PCE PATIENT CARE ENCOUNTER;**37,67,99**;Aug 12, 1996
;; ;
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)
. D PATINFO^PXCEPAT(.PXCEPAT)
;
I '$D(PXCEHLOC) N PXCEHLOC S PXCEHLOC=$P($G(^AUPNVSIT(PXCEVIEN,0)),"^",22)
;+If not called from encounter viewer lock ^PXLCKUSR
;+and create ^XTMP("PXLCKUSR",VISIEN)=DUZ
I PXCEKEYS'["V" D
.N PXRESVAL,PXVISIEN,PXMSG,PXUSR
.S PXMSG="",PXVISIEN=PXCEVIEN
.I $D(^XTMP("PXLCKUSR",PXVISIEN)) S PXUSR=$G(^VA(200,^XTMP("PXLCKUSR",PXVISIEN),0)),PXUSR=$S(PXUSR="":"Unknown",1:$P(PXUSR,"^")),PXMSG="Encounter Locked by "_PXUSR
.S PXRESVAL=$$LOCK^PXUALOCK("^PXLCKUSR("_PXVISIEN_")",5,0,PXMSG,0)
.I 'PXRESVAL Q
.S PXRESVAL=$$CREATE^PXUAXTMP("PXLCKUSR",PXVISIEN,365,"PCE Encounter Lock",DUZ)
.I 'PXRESVAL D UNLOCK^PXUALOCK("^PXLCKUSR("_PXVISIEN_")") Q
.D EN^VALM("PXCE ADD/EDIT MENU")
.D UNLOCK^PXUALOCK("^PXLCKUSR("_PXVISIEN_")"),DELETE^PXUAXTMP("PXLCKUSR",PXVISIEN)
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))
;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)
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",1)
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~"[("~"_PXCECAT_"~"):WHATTODO,1:"QUIT")
Q
;
QUIT Q
;
PXCEAE ;ISL/dee,ISA/KWP - Main routine for the List Manager display of a visit and related v-files ;04/26/99
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**37,67,99**;Aug 12, 1996
+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)
+10 DO PATINFO^PXCEPAT(.PXCEPAT)
End DoDot:1
+11 ;
+12 IF '$DATA(PXCEHLOC)
NEW PXCEHLOC
SET PXCEHLOC=$PIECE($GET(^AUPNVSIT(PXCEVIEN,0)),"^",22)
+13 ;+If not called from encounter viewer lock ^PXLCKUSR
+14 ;+and create ^XTMP("PXLCKUSR",VISIEN)=DUZ
+15 IF PXCEKEYS'["V"
Begin DoDot:1
+16 NEW PXRESVAL,PXVISIEN,PXMSG,PXUSR
+17 SET PXMSG=""
SET PXVISIEN=PXCEVIEN
+18 IF $DATA(^XTMP("PXLCKUSR",PXVISIEN))
SET PXUSR=$GET(^VA(200,^XTMP("PXLCKUSR",PXVISIEN),0))
SET PXUSR=$SELECT(PXUSR="":"Unknown",1:$PIECE(PXUSR,"^"))
SET PXMSG="Encounter Locked by "_PXUSR
+19 SET PXRESVAL=$$LOCK^PXUALOCK("^PXLCKUSR("_PXVISIEN_")",5,0,PXMSG,0)
+20 IF 'PXRESVAL
QUIT
+21 SET PXRESVAL=$$CREATE^PXUAXTMP("PXLCKUSR",PXVISIEN,365,"PCE Encounter Lock",DUZ)
+22 IF 'PXRESVAL
DO UNLOCK^PXUALOCK("^PXLCKUSR("_PXVISIEN_")")
QUIT
+23 DO EN^VALM("PXCE ADD/EDIT MENU")
+24 DO UNLOCK^PXUALOCK("^PXLCKUSR("_PXVISIEN_")")
DO DELETE^PXUAXTMP("PXLCKUSR",PXVISIEN)
End DoDot:1
+25 IF PXCEKEYS["V"
IF $DATA(^TMP("VALM DATA",$JOB,VALMEVL,"EXP"))
IF ^("EXP")]""
XECUTE ^("EXP")
+26 QUIT
+27 ;
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 ;Check that it is not related to a no show or canceled apppointment
+7 DO APPCHECK^PXCESDAM(.PXCEVIEN)
+8 IF '$DATA(PXCEVIEN)
QUIT
+9 ;Cannot edit future visits
+10 IF $PIECE(+^AUPNVSIT(PXCEVIEN,0),".")>DT
Begin DoDot:1
+11 WRITE !!,$CHAR(7),"Can not update future encounters."
+12 DO WAIT^PXCEHELP
+13 KILL PXCEVIEN
End DoDot:1
QUIT
+14 ;Check if the visit can be associated with an appointment.
+15 SET PXCEAPPM=$GET(^DPT($PIECE(^AUPNVSIT(PXCEVIEN,0),"^",5),"S",+^AUPNVSIT(PXCEVIEN,0),0))
+16 IF $PIECE(PXCEVIEN,"^",7)="E"
Begin DoDot:1
+17 WRITE !!,"This is a historical encounter for documenting a clinical encounter only"
+18 WRITE !,"and will not be used by Scheduling, Billing or Workload credit."
+19 DO PAUSE^PXCEHELP
End DoDot:1
IF 'Y
KILL PXCEVIEN
QUIT
+20 QUIT
+21 ;
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 DO EVENT^PXKMAIN
+10 KILL PXCEVIEN,PXCEAPPM
+11 QUIT
+12 ;
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",1)
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 DO @$SELECT("~VST~HIST~CSTP~CPT~IMM~PED~POV~PRV~SK~TRT~HF~XAM~"[("~"_PXCECAT_"~"):WHATTODO,1:"QUIT")
+13 QUIT
+14 ;
QUIT QUIT
+1 ;
