PXCESDAM ;ISL/dee,ALB/Zoltan - PCE List Manager display of appointments ;11/20/98
;;1.0;PCE PATIENT CARE ENCOUNTER;**1,34,147,172**;Aug 12, 1996
;
;Originally Developed using code from:
SDAM ;MJK/ALB - Appt Mgt ; 12/1/91
;;5.3;Scheduling;;Aug 13, 1993
Q
;
; -- kill off handle data
EN ; -- main entry point
D FULL^VALM1
D EN^VALM("PXCE SDAM MENU")
D MAKELIST^PXCENEW
Q
;
INIT ; -- set up appt man vars
K I,X,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ,%B
S $P(PXCEVIEW,"^",2)="A"
I PXCEVIEW["P" D INTSDAM1^PXCESDA1
I PXCEVIEW["H" D INTSDAM3^PXCESDA3
Q
;
FNL ; -- what to do after action
D CLEAN^VALM10
K ^TMP("SDAM",$J),^TMP("SDAMIDX",$J),^TMP("VALMIDX",$J)
K SDAMCNT,SDFLDD,SDACNT,VALMHCNT,SDPRD,SDFN,SDCLN,SDAMLIST,SDT,SDATA,SDY,X,SDCL,Y,SDDA,VALMY
Q
;
EXIT ; -- exit action for protocol
D:PXCEVIEW'["P" PATKILL^PXCEPAT
Q
;
EXPND ; -- expand code
D EN^PXCEEXP
Q
;
SEL ;
N PXCEVIEN
N PXCEAPDT S PXCEAPDT=""
I '$D(PXCEPAT) N PXCEPAT S PXCEPAT=""
I '$D(PXCEHLOC) N PXCEHLOC S PXCEHLOC=""
S PXCEVIEN=$$SELAPPM
I PXCEVIEN=-1 G SELQ
; next 3 lines PX*1.0*172
N PXREC,PXDUZ,PXPTSSN S PXDUZ=DUZ,PXPTSSN=$TR($G(PXCEPAT("SSN")),"-")
D SEC^PXCEEXP(.PXREC,PXDUZ,PXPTSSN)
I PXREC W !!,"Security regulations prohibit computer access to your own medical record." H 3 G SELQ
;
D APPCHECK(.PXCEVIEN,PXCEHLOC,PXCEAPDT,PXCEPAT)
I '$D(PXCEVIEN) G SELQ
D:PXCEVIEN="" EN^PXCEVFIL("APPM")
D:PXCEVIEN>0 EN^PXCEAE
SELQ K ^UTILITY("VASD",$J)
Q
;
SELAPPM() ;
N SDW,SDERR
S SDW=+$P(XQORNOD(0),"^",3)
I SDW'>0 K SDW D SELSDAM I '$D(SDW)!SDERR Q -1
I $P($P(^TMP("SDAMIDX",$J,SDW),"^",3),".",1)>DT D Q -1
. W !!,$C(7),"Can not update future encounters."
. D WAIT^PXCEHELP
D FULL^VALM1
N PXCEVIEN,PXCEINDX
I '$D(PXCEAPDT) N PXCEAPDT
I '$D(PXCEPAT) N PXCEPAT
I '$D(PXCEHLOC) N PXCEHLOC
S PXCEAPDT=$P(^TMP("SDAMIDX",$J,SDW),"^",3)
I $G(PXCEPAT)="" S PXCEPAT=$P(^TMP("SDAMIDX",$J,SDW),"^",2) D PATINFO^PXCEPAT(.PXCEPAT) I $D(DIRUT) Q -1
I $G(PXCEHLOC)="" S PXCEHLOC=$P(^TMP("SDAMIDX",$J,SDW),"^",4)
;
;Look for visits for this patient at the appointment date and time.
S PXCEVIEN=$$APPT2VST^PXUTL1(PXCEPAT,PXCEAPDT,PXCEHLOC)
Q $S(PXCEVIEN>0:PXCEVIEN,1:"")
;
SELSDAM ; -- select processing
N BG,LST,Y
N DIRUT,DTOUT,DUOUT,DIROUT,DIR,DA
S BG=1
S LST=+$O(@VALMAR@("IDX",VALMCNT,0))
I LST=BG S SDERR=0,SDW=BG Q
I 'LST W !!,$C(7),"There are no '",VALM("ENTITY"),"s' to select.",! D WAIT^PXCEHELP S SDERR=1 Q
S Y=+$P($P(XQORNOD(0),U,4),"=",2)
I 'Y S DIR(0)="N^"_BG_":"_LST,DIR("A")="Select "_VALM("ENTITY") D ^DIR I $D(DIRUT) S SDERR=1 Q
;
; -- check was valid entries
S SDERR=0,SDW=Y
I SDW<BG!(SDW>LST) D
.W !,$C(7),"Selection '",SDW,"' is not a valid choice."
.S SDERR=1
.D WAIT^PXCEHELP
Q
;
APPCHECK(PXCEVIEN,PXCEHLOC,PXCEAPDT,PXCEPAT) ; Pass in PXCEVIEN and kills it if should not be selected.
I PXCEVIEN="" D Q
. I $$CANCEL($G(PXCEHLOC),$G(PXCEAPDT),$G(PXCEPAT)) K PXCEVIEN
N VASD,VAERR
S VASD("W")=345678
S VASD("F")=+^AUPNVSIT(PXCEVIEN,0)-.0000001
S VASD("T")=VASD("F")+.0000002
S VASD("C",+$P(^AUPNVSIT(PXCEVIEN,0),"^",22))=""
D SDA^VADPT
I $D(^UTILITY("VASD",$J)) D
. I 'PXCEVIEN D
.. W !,$C(7),"PCE has no data related to this appointment."
.. W !,"You cannot add data for an appointment that has a status of ",$P(^UTILITY("VASD",$J,1,"E"),"^",3)
.. K PXCEVIEN
.. D WAIT^PXCEHELP
. E I PXCEKEYS["S" D
.. N DIR,DA
.. W !,$C(7),"Appointment has a status of ",$P(^UTILITY("VASD",$J,1,"E"),"^",3)
.. S DIR("A",1)="WARNING: Data stored in PCE related to this appointment"
.. S DIR("A",2)=" will NOT be used for Workload or Billing. This is a bad encounter"
.. S DIR("A")="Do you want to continue with this encounter"
.. S DIR("B")="NO"
.. S DIR(0)="Y"
.. D ^DIR
.. I Y'=1 K PXCEVIEN
. E D
.. W !,$C(7),"Appointment has a status of ",$P(^UTILITY("VASD",$J,1,"E"),"^",3)
.. W !,"WARNING: Data stored in PCE related to this appointment"
.. W !," will NOT be used for Workload or Billing. This is a bad encounter"
.. W !,"You must use a PCE Superviser option to access the encounter."
.. K PXCEVIEN
.. D WAIT^PXCEHELP
;
; Exit if we already know it should not be selected.
I $D(PXCEVIEN)["0" Q
;
;If Supervisor then ask if want to edit ancillary package data
I PXCEKEYS["S",$P($G(^AUPNVSIT(PXCEVIEN,150)),"^",3)="A" D
. N DIR,DA
. W $C(7)
. S DIR("A",1)="WARNING: Data stored in PCE came from another package and should"
. S DIR("A",2)=" only be changed in that package. If it is changed by PCE it will"
. S DIR("A",3)=" not agree with what is in the originating package."
. S DIR("A")="Do you want to continue with this encounter"
. S DIR("B")="NO"
. S DIR(0)="Y"
. D ^DIR
. I Y'=1 K PXCEVIEN
Q
;
CANCEL(PXHL,PXDT,PXDFN) ; True if the appointment is cancelled or no-showed.
N STATUS,CANC
S CANC=0
I PXHL,PXDT,PXDFN,PXHL=+$G(^DPT(PXDFN,"S",PXDT,0)) D
. S STATUS=$P(^DPT(PXDFN,"S",PXDT,0),U,2)
. I STATUS["N"!(STATUS["C") S CANC=1
Q CANC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCESDAM 5092 printed Nov 22, 2024@17:38:16 Page 2
PXCESDAM ;ISL/dee,ALB/Zoltan - PCE List Manager display of appointments ;11/20/98
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,34,147,172**;Aug 12, 1996
+2 ;
+3 ;Originally Developed using code from:
SDAM ;MJK/ALB - Appt Mgt ; 12/1/91
+1 ;;5.3;Scheduling;;Aug 13, 1993
+2 QUIT
+3 ;
+4 ; -- kill off handle data
EN ; -- main entry point
+1 DO FULL^VALM1
+2 DO EN^VALM("PXCE SDAM MENU")
+3 DO MAKELIST^PXCENEW
+4 QUIT
+5 ;
INIT ; -- set up appt man vars
+1 KILL I,X,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ,%B
+2 SET $PIECE(PXCEVIEW,"^",2)="A"
+3 IF PXCEVIEW["P"
DO INTSDAM1^PXCESDA1
+4 IF PXCEVIEW["H"
DO INTSDAM3^PXCESDA3
+5 QUIT
+6 ;
FNL ; -- what to do after action
+1 DO CLEAN^VALM10
+2 KILL ^TMP("SDAM",$JOB),^TMP("SDAMIDX",$JOB),^TMP("VALMIDX",$JOB)
+3 KILL SDAMCNT,SDFLDD,SDACNT,VALMHCNT,SDPRD,SDFN,SDCLN,SDAMLIST,SDT,SDATA,SDY,X,SDCL,Y,SDDA,VALMY
+4 QUIT
+5 ;
EXIT ; -- exit action for protocol
+1 if PXCEVIEW'["P"
DO PATKILL^PXCEPAT
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 DO EN^PXCEEXP
+2 QUIT
+3 ;
SEL ;
+1 NEW PXCEVIEN
+2 NEW PXCEAPDT
SET PXCEAPDT=""
+3 IF '$DATA(PXCEPAT)
NEW PXCEPAT
SET PXCEPAT=""
+4 IF '$DATA(PXCEHLOC)
NEW PXCEHLOC
SET PXCEHLOC=""
+5 SET PXCEVIEN=$$SELAPPM
+6 IF PXCEVIEN=-1
GOTO SELQ
+7 ; next 3 lines PX*1.0*172
+8 NEW PXREC,PXDUZ,PXPTSSN
SET PXDUZ=DUZ
SET PXPTSSN=$TRANSLATE($GET(PXCEPAT("SSN")),"-")
+9 DO SEC^PXCEEXP(.PXREC,PXDUZ,PXPTSSN)
+10 IF PXREC
WRITE !!,"Security regulations prohibit computer access to your own medical record."
HANG 3
GOTO SELQ
+11 ;
+12 DO APPCHECK(.PXCEVIEN,PXCEHLOC,PXCEAPDT,PXCEPAT)
+13 IF '$DATA(PXCEVIEN)
GOTO SELQ
+14 if PXCEVIEN=""
DO EN^PXCEVFIL("APPM")
+15 if PXCEVIEN>0
DO EN^PXCEAE
SELQ KILL ^UTILITY("VASD",$JOB)
+1 QUIT
+2 ;
SELAPPM() ;
+1 NEW SDW,SDERR
+2 SET SDW=+$PIECE(XQORNOD(0),"^",3)
+3 IF SDW'>0
KILL SDW
DO SELSDAM
IF '$DATA(SDW)!SDERR
QUIT -1
+4 IF $PIECE($PIECE(^TMP("SDAMIDX",$JOB,SDW),"^",3),".",1)>DT
Begin DoDot:1
+5 WRITE !!,$CHAR(7),"Can not update future encounters."
+6 DO WAIT^PXCEHELP
End DoDot:1
QUIT -1
+7 DO FULL^VALM1
+8 NEW PXCEVIEN,PXCEINDX
+9 IF '$DATA(PXCEAPDT)
NEW PXCEAPDT
+10 IF '$DATA(PXCEPAT)
NEW PXCEPAT
+11 IF '$DATA(PXCEHLOC)
NEW PXCEHLOC
+12 SET PXCEAPDT=$PIECE(^TMP("SDAMIDX",$JOB,SDW),"^",3)
+13 IF $GET(PXCEPAT)=""
SET PXCEPAT=$PIECE(^TMP("SDAMIDX",$JOB,SDW),"^",2)
DO PATINFO^PXCEPAT(.PXCEPAT)
IF $DATA(DIRUT)
QUIT -1
+14 IF $GET(PXCEHLOC)=""
SET PXCEHLOC=$PIECE(^TMP("SDAMIDX",$JOB,SDW),"^",4)
+15 ;
+16 ;Look for visits for this patient at the appointment date and time.
+17 SET PXCEVIEN=$$APPT2VST^PXUTL1(PXCEPAT,PXCEAPDT,PXCEHLOC)
+18 QUIT $SELECT(PXCEVIEN>0:PXCEVIEN,1:"")
+19 ;
SELSDAM ; -- select processing
+1 NEW BG,LST,Y
+2 NEW DIRUT,DTOUT,DUOUT,DIROUT,DIR,DA
+3 SET BG=1
+4 SET LST=+$ORDER(@VALMAR@("IDX",VALMCNT,0))
+5 IF LST=BG
SET SDERR=0
SET SDW=BG
QUIT
+6 IF 'LST
WRITE !!,$CHAR(7),"There are no '",VALM("ENTITY"),"s' to select.",!
DO WAIT^PXCEHELP
SET SDERR=1
QUIT
+7 SET Y=+$PIECE($PIECE(XQORNOD(0),U,4),"=",2)
+8 IF 'Y
SET DIR(0)="N^"_BG_":"_LST
SET DIR("A")="Select "_VALM("ENTITY")
DO ^DIR
IF $DATA(DIRUT)
SET SDERR=1
QUIT
+9 ;
+10 ; -- check was valid entries
+11 SET SDERR=0
SET SDW=Y
+12 IF SDW<BG!(SDW>LST)
Begin DoDot:1
+13 WRITE !,$CHAR(7),"Selection '",SDW,"' is not a valid choice."
+14 SET SDERR=1
+15 DO WAIT^PXCEHELP
End DoDot:1
+16 QUIT
+17 ;
APPCHECK(PXCEVIEN,PXCEHLOC,PXCEAPDT,PXCEPAT) ; Pass in PXCEVIEN and kills it if should not be selected.
+1 IF PXCEVIEN=""
Begin DoDot:1
+2 IF $$CANCEL($GET(PXCEHLOC),$GET(PXCEAPDT),$GET(PXCEPAT))
KILL PXCEVIEN
End DoDot:1
QUIT
+3 NEW VASD,VAERR
+4 SET VASD("W")=345678
+5 SET VASD("F")=+^AUPNVSIT(PXCEVIEN,0)-.0000001
+6 SET VASD("T")=VASD("F")+.0000002
+7 SET VASD("C",+$PIECE(^AUPNVSIT(PXCEVIEN,0),"^",22))=""
+8 DO SDA^VADPT
+9 IF $DATA(^UTILITY("VASD",$JOB))
Begin DoDot:1
+10 IF 'PXCEVIEN
Begin DoDot:2
+11 WRITE !,$CHAR(7),"PCE has no data related to this appointment."
+12 WRITE !,"You cannot add data for an appointment that has a status of ",$PIECE(^UTILITY("VASD",$JOB,1,"E"),"^",3)
+13 KILL PXCEVIEN
+14 DO WAIT^PXCEHELP
End DoDot:2
+15 IF '$TEST
IF PXCEKEYS["S"
Begin DoDot:2
+16 NEW DIR,DA
+17 WRITE !,$CHAR(7),"Appointment has a status of ",$PIECE(^UTILITY("VASD",$JOB,1,"E"),"^",3)
+18 SET DIR("A",1)="WARNING: Data stored in PCE related to this appointment"
+19 SET DIR("A",2)=" will NOT be used for Workload or Billing. This is a bad encounter"
+20 SET DIR("A")="Do you want to continue with this encounter"
+21 SET DIR("B")="NO"
+22 SET DIR(0)="Y"
+23 DO ^DIR
+24 IF Y'=1
KILL PXCEVIEN
End DoDot:2
+25 IF '$TEST
Begin DoDot:2
+26 WRITE !,$CHAR(7),"Appointment has a status of ",$PIECE(^UTILITY("VASD",$JOB,1,"E"),"^",3)
+27 WRITE !,"WARNING: Data stored in PCE related to this appointment"
+28 WRITE !," will NOT be used for Workload or Billing. This is a bad encounter"
+29 WRITE !,"You must use a PCE Superviser option to access the encounter."
+30 KILL PXCEVIEN
+31 DO WAIT^PXCEHELP
End DoDot:2
End DoDot:1
+32 ;
+33 ; Exit if we already know it should not be selected.
+34 IF $DATA(PXCEVIEN)["0"
QUIT
+35 ;
+36 ;If Supervisor then ask if want to edit ancillary package data
+37 IF PXCEKEYS["S"
IF $PIECE($GET(^AUPNVSIT(PXCEVIEN,150)),"^",3)="A"
Begin DoDot:1
+38 NEW DIR,DA
+39 WRITE $CHAR(7)
+40 SET DIR("A",1)="WARNING: Data stored in PCE came from another package and should"
+41 SET DIR("A",2)=" only be changed in that package. If it is changed by PCE it will"
+42 SET DIR("A",3)=" not agree with what is in the originating package."
+43 SET DIR("A")="Do you want to continue with this encounter"
+44 SET DIR("B")="NO"
+45 SET DIR(0)="Y"
+46 DO ^DIR
+47 IF Y'=1
KILL PXCEVIEN
End DoDot:1
+48 QUIT
+49 ;
CANCEL(PXHL,PXDT,PXDFN) ; True if the appointment is cancelled or no-showed.
+1 NEW STATUS,CANC
+2 SET CANC=0
+3 IF PXHL
IF PXDT
IF PXDFN
IF PXHL=+$GET(^DPT(PXDFN,"S",PXDT,0))
Begin DoDot:1
+4 SET STATUS=$PIECE(^DPT(PXDFN,"S",PXDT,0),U,2)
+5 IF STATUS["N"!(STATUS["C")
SET CANC=1
End DoDot:1
+6 QUIT CANC
