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

PXCESDAM.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;Originally Developed using code from:
  1. SDAM ;MJK/ALB - Appt Mgt ; 12/1/91
  1.  ;;5.3;Scheduling;;Aug 13, 1993
  1.  Q
  1.  ;
  1.  ; -- kill off handle data
  1. EN ; -- main entry point
  1.  D FULL^VALM1
  1.  D EN^VALM("PXCE SDAM MENU")
  1.  D MAKELIST^PXCENEW
  1.  Q
  1.  ;
  1. INIT ; -- set up appt man vars
  1.  K I,X,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ,%B
  1.  S $P(PXCEVIEW,"^",2)="A"
  1.  I PXCEVIEW["P" D INTSDAM1^PXCESDA1
  1.  I PXCEVIEW["H" D INTSDAM3^PXCESDA3
  1.  Q
  1.  ;
  1. FNL ; -- what to do after action
  1.  D CLEAN^VALM10
  1.  K ^TMP("SDAM",$J),^TMP("SDAMIDX",$J),^TMP("VALMIDX",$J)
  1.  K SDAMCNT,SDFLDD,SDACNT,VALMHCNT,SDPRD,SDFN,SDCLN,SDAMLIST,SDT,SDATA,SDY,X,SDCL,Y,SDDA,VALMY
  1.  Q
  1.  ;
  1. EXIT ; -- exit action for protocol
  1.  D:PXCEVIEW'["P" PATKILL^PXCEPAT
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  D EN^PXCEEXP
  1.  Q
  1.  ;
  1. SEL ;
  1.  N PXCEVIEN
  1.  N PXCEAPDT S PXCEAPDT=""
  1.  I '$D(PXCEPAT) N PXCEPAT S PXCEPAT=""
  1.  I '$D(PXCEHLOC) N PXCEHLOC S PXCEHLOC=""
  1.  S PXCEVIEN=$$SELAPPM
  1.  I PXCEVIEN=-1 G SELQ
  1.  ; next 3 lines PX*1.0*172
  1.  N PXREC,PXDUZ,PXPTSSN S PXDUZ=DUZ,PXPTSSN=$TR($G(PXCEPAT("SSN")),"-")
  1.  D SEC^PXCEEXP(.PXREC,PXDUZ,PXPTSSN)
  1.  I PXREC W !!,"Security regulations prohibit computer access to your own medical record." H 3 G SELQ
  1.  ;
  1.  D APPCHECK(.PXCEVIEN,PXCEHLOC,PXCEAPDT,PXCEPAT)
  1.  I '$D(PXCEVIEN) G SELQ
  1.  D:PXCEVIEN="" EN^PXCEVFIL("APPM")
  1.  D:PXCEVIEN>0 EN^PXCEAE
  1. SELQ K ^UTILITY("VASD",$J)
  1.  Q
  1.  ;
  1. SELAPPM() ;
  1.  N SDW,SDERR
  1.  S SDW=+$P(XQORNOD(0),"^",3)
  1.  I SDW'>0 K SDW D SELSDAM I '$D(SDW)!SDERR Q -1
  1.  I $P($P(^TMP("SDAMIDX",$J,SDW),"^",3),".",1)>DT D  Q -1
  1.  . W !!,$C(7),"Can not update future encounters."
  1.  . D WAIT^PXCEHELP
  1.  D FULL^VALM1
  1.  N PXCEVIEN,PXCEINDX
  1.  I '$D(PXCEAPDT) N PXCEAPDT
  1.  I '$D(PXCEPAT) N PXCEPAT
  1.  I '$D(PXCEHLOC) N PXCEHLOC
  1.  S PXCEAPDT=$P(^TMP("SDAMIDX",$J,SDW),"^",3)
  1.  I $G(PXCEPAT)="" S PXCEPAT=$P(^TMP("SDAMIDX",$J,SDW),"^",2) D PATINFO^PXCEPAT(.PXCEPAT) I $D(DIRUT) Q -1
  1.  I $G(PXCEHLOC)="" S PXCEHLOC=$P(^TMP("SDAMIDX",$J,SDW),"^",4)
  1.  ;
  1.  ;Look for visits for this patient at the appointment date and time.
  1.  S PXCEVIEN=$$APPT2VST^PXUTL1(PXCEPAT,PXCEAPDT,PXCEHLOC)
  1.  Q $S(PXCEVIEN>0:PXCEVIEN,1:"")
  1.  ;
  1. SELSDAM ; -- select processing
  1.  N BG,LST,Y
  1.  N DIRUT,DTOUT,DUOUT,DIROUT,DIR,DA
  1.  S BG=1
  1.  S LST=+$O(@VALMAR@("IDX",VALMCNT,0))
  1.  I LST=BG S SDERR=0,SDW=BG Q
  1.  I 'LST W !!,$C(7),"There are no '",VALM("ENTITY"),"s' to select.",! D WAIT^PXCEHELP S SDERR=1 Q
  1.  S Y=+$P($P(XQORNOD(0),U,4),"=",2)
  1.  I 'Y S DIR(0)="N^"_BG_":"_LST,DIR("A")="Select "_VALM("ENTITY") D ^DIR I $D(DIRUT) S SDERR=1 Q
  1.  ;
  1.  ; -- check was valid entries
  1.  S SDERR=0,SDW=Y
  1.  I SDW<BG!(SDW>LST) D
  1.  .W !,$C(7),"Selection '",SDW,"' is not a valid choice."
  1.  .S SDERR=1
  1.  .D WAIT^PXCEHELP
  1.  Q
  1.  ;
  1. APPCHECK(PXCEVIEN,PXCEHLOC,PXCEAPDT,PXCEPAT) ; Pass in PXCEVIEN and kills it if should not be selected.
  1.  I PXCEVIEN="" D  Q
  1.  . I $$CANCEL($G(PXCEHLOC),$G(PXCEAPDT),$G(PXCEPAT)) K PXCEVIEN
  1.  N VASD,VAERR
  1.  S VASD("W")=345678
  1.  S VASD("F")=+^AUPNVSIT(PXCEVIEN,0)-.0000001
  1.  S VASD("T")=VASD("F")+.0000002
  1.  S VASD("C",+$P(^AUPNVSIT(PXCEVIEN,0),"^",22))=""
  1.  D SDA^VADPT
  1.  I $D(^UTILITY("VASD",$J)) D
  1.  . I 'PXCEVIEN D
  1.  .. W !,$C(7),"PCE has no data related to this appointment."
  1.  .. W !,"You cannot add data for an appointment that has a status of ",$P(^UTILITY("VASD",$J,1,"E"),"^",3)
  1.  .. K PXCEVIEN
  1.  .. D WAIT^PXCEHELP
  1.  . E  I PXCEKEYS["S" D
  1.  .. N DIR,DA
  1.  .. W !,$C(7),"Appointment has a status of ",$P(^UTILITY("VASD",$J,1,"E"),"^",3)
  1.  .. S DIR("A",1)="WARNING: Data stored in PCE related to this appointment"
  1.  .. S DIR("A",2)="  will NOT be used for Workload or Billing.  This is a bad encounter"
  1.  .. S DIR("A")="Do you want to continue with this encounter"
  1.  .. S DIR("B")="NO"
  1.  .. S DIR(0)="Y"
  1.  .. D ^DIR
  1.  .. I Y'=1 K PXCEVIEN
  1.  . E  D
  1.  .. W !,$C(7),"Appointment has a status of ",$P(^UTILITY("VASD",$J,1,"E"),"^",3)
  1.  .. W !,"WARNING: Data stored in PCE related to this appointment"
  1.  .. W !,"  will NOT be used for Workload or Billing.  This is a bad encounter"
  1.  .. W !,"You must use a PCE Superviser option to access the encounter."
  1.  .. K PXCEVIEN
  1.  .. D WAIT^PXCEHELP
  1.  ;
  1.  ; Exit if we already know it should not be selected.
  1.  I $D(PXCEVIEN)["0" Q
  1.  ;
  1.  ;If Supervisor then ask if want to edit ancillary package data
  1.  I PXCEKEYS["S",$P($G(^AUPNVSIT(PXCEVIEN,150)),"^",3)="A" D
  1.  . N DIR,DA
  1.  . W $C(7)
  1.  . S DIR("A",1)="WARNING: Data stored in PCE came from another package and should"
  1.  . S DIR("A",2)="  only be changed in that package.  If it is changed by PCE it will"
  1.  . S DIR("A",3)="  not agree with what is in the originating package."
  1.  . S DIR("A")="Do you want to continue with this encounter"
  1.  . S DIR("B")="NO"
  1.  . S DIR(0)="Y"
  1.  . D ^DIR
  1.  . I Y'=1 K PXCEVIEN
  1.  Q
  1.  ;
  1. CANCEL(PXHL,PXDT,PXDFN) ; True if the appointment is cancelled or no-showed.
  1.  N STATUS,CANC
  1.  S CANC=0
  1.  I PXHL,PXDT,PXDFN,PXHL=+$G(^DPT(PXDFN,"S",PXDT,0)) D
  1.  . S STATUS=$P(^DPT(PXDFN,"S",PXDT,0),U,2)
  1.  . I STATUS["N"!(STATUS["C") S CANC=1
  1.  Q CANC