- 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 Jan 18, 2025@03:28:50 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 ;