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

SDACSCG.m

Go to the documentation of this file. 
  1. SDACSCG ;ALB/TET - Print/Edit Computer Generated Appt Types ;3/18/92  14:18
  1.  ;;5.3;Scheduling;**16,22,132,202,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  Q
  1. CK ; -- check the number of computer generated visits
  1.  N SDT,SDOE,CT
  1.  S (SDT,CT)=0
  1.  F  S SDT=$O(^SCE("ACG",SDT)) Q:'SDT  D
  1.  . S SDOE=0
  1.  . F  S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE  S CT=CT+1
  1.  ;
  1.  I CT D
  1.  . W !?5,"There are ",CT," encounter(s) with a 'Computer Generated' appointment type.",*7,!
  1.  E  D
  1.  . W !?5,"There are no 'Computer Generated' appointment type encounters."
  1.  Q
  1.  ;
  1. PRINT ;print those CG types which need to be manually updated
  1.  S DGPGM="QUE^SDACSCG"
  1.  D ZIS^DGUTQ
  1.  Q:POP
  1.  ;
  1. QUE ; -- queue entry point
  1.  N SDOE,SDOE0,SDT,DSAH,SDY,CT,Y,X,VA,VADM,VAERR,CT,%DT
  1.  S DASH="",$P(DASH,"-",79)=""
  1.  S (SDT,CT)=0,%DT="SX"
  1.  D HDR
  1.  F  S SDT=$O(^SCE("ACG",SDT)) Q:'SDT  D  G:$D(DTOUT)!($D(DUOUT)) EXIT
  1.  . S Y=SDT D DD^%DT S SDY=Y
  1.  . S SDOE=0
  1.  . F  S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE  D  Q:$D(DTOUT)!($D(DUOUT))
  1.  . . S SDOE0=$G(^SCE(SDOE,0))
  1.  . . S DFN=+$P(SDOE0,U,2)
  1.  . . D DEM^VADPT
  1.  . . D:$Y+6>IOSL CR,HDR
  1.  . . Q:$D(DTOUT)!($D(DUOUT))
  1.  . . W !,SDY,?25,$S(VAERR=0:VADM(1),1:"UNKNOWN"),?60,VA("PID")
  1.  . . S CT=CT+1
  1.  I CT D:$Y+4>IOSL CR W !!,CT," MATCHES FOUND.",!
  1.  ;
  1. EXIT ; -- exit processing
  1.  K %DT,CT,D,DA,DASH,DE,DFN,DFN0,DGPGM,DIC,DIE,DIRUT,DQ
  1.  K DR,DTOUT,DUOUT,FR,I,J,POP,SDA,SDAPTYP,SDBEG,SDCSNODE
  1.  K SDDIV,SDEND,SDUPDT,SDY,SDZN,SDTYPE,TO,VADM,VAEL,VAERR,VA,X,Y
  1.  Q
  1.  ;
  1. CR ; -- end of page processing
  1.  Q:$E(IOST,1,2)'="C-"
  1.  W !!,"Press RETURN to continue or '^' to exit: "
  1.  R SDXX:DTIME S:'$T DTOUT=1
  1.  Q:$D(DTOUT)!(SDXX="")
  1.  I SDXX="^" S DUOUT=1 Q
  1.  W !?5,"Enter an '^' to exit the listing, or enter RETURN to continue."
  1.  G CR
  1.  ;
  1. HDR ; -- header processing
  1.  W:$D(IOF) @IOF W !,"COMPUTER GENERATED APPOINTMENT TYPES"
  1.  W !,"ENCOUNTER DATE/TIME",?25,"PATIENT",?60,"PT ID",!,DASH,!!
  1.  Q
  1.  ;
  1. EDIT ; -- edit computer generated appt types
  1.  N DIR,SDOUT,%DT
  1.  I '$O(^SCE("ACG",0)) W !!?5,"There are no 'Computer Generated' Appointment Types which need updating." G EDITQ
  1.  ;
  1.  W !
  1.  S DIR("A",1)="You may enter one of the following:"
  1.  S DIR("A",2)="         Encounter Date - edit 'Computer Generated' entries for a specific date"
  1.  S DIR("A",3)="  Patient Name (or SSN) - edit 'Computer Generated' entries for one patient"
  1.  S DIR("A",4)="  The default of 'ALL'  - edit all entries which are 'Computer Generated'"
  1.  S DIR("A")="Select Encounter Date"
  1.  S DIR("B")="ALL"
  1.  S DIR(0)="F^1:30"
  1.  S %DT(0)="-DT"
  1.  S DIR("?")="^D QUE^SDACSCG"
  1.  D ^DIR K DIR
  1.  G:$D(DIRUT) EDITQ
  1.  ;
  1.  S SDOUT=0
  1.  D
  1.  .N SDZ
  1.  .I "ALLall"[Y D  Q
  1.  ..D ALL
  1.  .S (X,SDZ)=Y,%DT="PX"
  1.  .D ^%DT
  1.  .I Y'=-1 D  Q
  1.  ..S Y=SDZ
  1.  ..D DATE
  1.  .S Y=SDZ
  1.  .I Y?9N!(Y?1A4N)!(Y?.AP)!(Y?4N) D  Q
  1.  ..D DPT
  1.  ;
  1.  I 'SDOUT G EDIT
  1.  ;
  1. EDITQ D EXIT
  1.  Q
  1.  ;
  1. DATE ;
  1.  N CT,%DT,Y,SDBEG,SDEND
  1.  S CT=0
  1.  S %DT="EPTXS"
  1.  S %DT(0)=-DT
  1.  D ^%DT S Y=+Y
  1.  IF $D(DTOUT) S SDOUT=1 G DATEQ
  1.  G DATEQ:Y=-1
  1.  ;
  1.  S SDBEG=$S(Y[".":Y-.000001,1:Y)
  1.  S SDEND=$S(Y[".":Y,1:Y_.999999)
  1.  D LOOP(SDBEG,SDEND)
  1.  ;
  1.  G:SDOUT DATEQ
  1.  W:'CT !,"There are no 'Computer Generated' appt types for selection.",*7,!
  1. DATEQ Q
  1.  ;
  1. ALL ; -- loop through and edit all computer generated appt types
  1.  N CT
  1.  S CT=0
  1.  ;
  1.  D LOOP()
  1.  ;
  1. ALLQ Q
  1.  ;
  1. DPT ; -- look up in patient file & loop through acg for selected dfn
  1.  ;
  1.  N DIC,D,CT,Y
  1.  S CT=0
  1.  S DIC="^DPT(",DIC(0)="EQMZ"
  1.  S D=$S(X?9N:"SSN",X?1A.4N:"B5",1:"B")
  1.  D IX^DIC
  1.  G DPTQ:Y'>0
  1.  ;
  1.  D LOOP(,,+Y)
  1.  ;
  1.  G:SDOUT DPTQ
  1.  W:'CT !,"There are no 'Computer Generated' appt types for selected entry.",*7,!
  1. DPTQ Q
  1.  ;
  1. LOOP(SDBEG,SDEND,SDFN) ;
  1.  N SDY,DFN,VA,VAERR,VAADM,SDT,SDOE
  1.  ;
  1.  IF '$G(SDBEG) N SDBEG S SDBEG=0
  1.  IF '$G(SDEND) N SDEND S SDEND=9999999
  1.  IF '$G(SDFN) N SDFN S SDFN=0
  1.  ;
  1.  S SDT=SDBEG
  1.  F  S SDT=$O(^SCE("ACG",SDT)) Q:'SDT!(SDT>SDEND)  D  Q:SDOUT
  1.  . S SDOE=0
  1.  . F  S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE  D  Q:SDOUT 
  1.  . . IF SDFN,SDFN'=+$P($G(^SCE(SDOE,0)),"^",2) Q
  1.  . . D DEM(SDOE),DEMW
  1.  . . D DIE(SDOE)
  1. LOOPQ Q
  1.  ;
  1. DEM(SDOE) ; -- get pt name,ssn and visit date
  1.  N SDOE0,Y,DFN
  1.  S SDOE0=$G(^SCE(SDOE,0))
  1.  S DFN=+$P(SDOE0,"^",2)
  1.  D DEM^VADPT
  1.  S Y=+SDOE0 D DD^%DT S SDY=Y
  1.  Q
  1.  ;
  1. DEMW ; -- write patient demographics
  1.  W !!,SDY,?25,$S(VAERR=0:VADM(1),1:"UNKNOWN"),?60,VA("PID")
  1.  Q
  1.  ;
  1. DIE(SDOE) ; -- do edit
  1.  N DR,DIE,DE,DQ
  1.  S DR=".1d;I $P(^(0),U,10)=10 S Y=""@99"";202///@;@99"
  1.  S DIE="^SCE("
  1.  S DA=SDOE
  1.  D ^DIE
  1.  S:$D(DTOUT)!($D(Y)'=0) SDOUT=1
  1.  S CT=CT+1
  1.  Q
  1.  ;