| [613] | 1 | SDACSCG ;ALB/TET - Print/Edit Computer Generated Appt Types ;3/18/92  14:18
 | 
|---|
 | 2 |  ;;5.3;Scheduling;**16,22,132,202**;Aug 13, 1993
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  Q
 | 
|---|
 | 5 | CK ; -- check the number of computer generated visits
 | 
|---|
 | 6 |  N SDT,SDOE,CT
 | 
|---|
 | 7 |  S (SDT,CT)=0
 | 
|---|
 | 8 |  F  S SDT=$O(^SCE("ACG",SDT)) Q:'SDT  D
 | 
|---|
 | 9 |  . S SDOE=0
 | 
|---|
 | 10 |  . F  S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE  S CT=CT+1
 | 
|---|
 | 11 |  ;
 | 
|---|
 | 12 |  I CT D
 | 
|---|
 | 13 |  . W !?5,"There are ",CT," encounter(s) with a 'Computer Generated' appointment type.",*7,!
 | 
|---|
 | 14 |  E  D
 | 
|---|
 | 15 |  . W !?5,"There are no 'Computer Generated' appointment type encounters."
 | 
|---|
 | 16 |  Q
 | 
|---|
 | 17 |  ;
 | 
|---|
 | 18 | PRINT ;print those CG types which need to be manually updated
 | 
|---|
 | 19 |  S DGPGM="QUE^SDACSCG"
 | 
|---|
 | 20 |  D ZIS^DGUTQ
 | 
|---|
 | 21 |  Q:POP
 | 
|---|
 | 22 |  ;
 | 
|---|
 | 23 | QUE ; -- queue entry point
 | 
|---|
 | 24 |  N SDOE,SDOE0,SDT,DSAH,SDY,CT,Y,X,VA,VADM,VAERR,CT,%DT
 | 
|---|
 | 25 |  S DASH="",$P(DASH,"-",79)=""
 | 
|---|
 | 26 |  S (SDT,CT)=0,%DT="SX"
 | 
|---|
 | 27 |  D HDR
 | 
|---|
 | 28 |  F  S SDT=$O(^SCE("ACG",SDT)) Q:'SDT  D  G:$D(DTOUT)!($D(DUOUT)) EXIT
 | 
|---|
 | 29 |  . S Y=SDT D DD^%DT S SDY=Y
 | 
|---|
 | 30 |  . S SDOE=0
 | 
|---|
 | 31 |  . F  S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE  D  Q:$D(DTOUT)!($D(DUOUT))
 | 
|---|
 | 32 |  . . S SDOE0=$G(^SCE(SDOE,0))
 | 
|---|
 | 33 |  . . S DFN=+$P(SDOE0,U,2)
 | 
|---|
 | 34 |  . . D DEM^VADPT
 | 
|---|
 | 35 |  . . D:$Y+6>IOSL CR,HDR
 | 
|---|
 | 36 |  . . Q:$D(DTOUT)!($D(DUOUT))
 | 
|---|
 | 37 |  . . W !,SDY,?25,$S(VAERR=0:VADM(1),1:"UNKNOWN"),?60,VA("PID")
 | 
|---|
 | 38 |  . . S CT=CT+1
 | 
|---|
 | 39 |  I CT D:$Y+4>IOSL CR W !!,CT," MATCHES FOUND.",!
 | 
|---|
 | 40 |  ;
 | 
|---|
 | 41 | EXIT ; -- exit processing
 | 
|---|
 | 42 |  K %DT,CT,D,DA,DASH,DE,DFN,DFN0,DGPGM,DIC,DIE,DIRUT,DQ
 | 
|---|
 | 43 |  K DR,DTOUT,DUOUT,FR,I,J,POP,SDA,SDAPTYP,SDBEG,SDCSNODE
 | 
|---|
 | 44 |  K SDDIV,SDEND,SDUPDT,SDY,SDZN,SDTYPE,TO,VADM,VAEL,VAERR,VA,X,Y
 | 
|---|
 | 45 |  Q
 | 
|---|
 | 46 |  ;
 | 
|---|
 | 47 | CR ; -- end of page processing
 | 
|---|
 | 48 |  Q:$E(IOST,1,2)'="C-"
 | 
|---|
 | 49 |  W !!,"Press RETURN to continue or '^' to exit: "
 | 
|---|
 | 50 |  R SDXX:DTIME S:'$T DTOUT=1
 | 
|---|
 | 51 |  Q:$D(DTOUT)!(SDXX="")
 | 
|---|
 | 52 |  I SDXX="^" S DUOUT=1 Q
 | 
|---|
 | 53 |  W !?5,"Enter an '^' to exit the listing, or enter RETURN to continue."
 | 
|---|
 | 54 |  G CR
 | 
|---|
 | 55 |  ;
 | 
|---|
 | 56 | HDR ; -- header processing
 | 
|---|
 | 57 |  W:$D(IOF) @IOF W !,"COMPUTER GENERATED APPOINTMENT TYPES"
 | 
|---|
 | 58 |  W !,"ENCOUNTER DATE/TIME",?25,"PATIENT",?60,"PT ID",!,DASH,!!
 | 
|---|
 | 59 |  Q
 | 
|---|
 | 60 |  ;
 | 
|---|
 | 61 | EDIT ; -- edit computer generated appt types
 | 
|---|
 | 62 |  N DIR,SDOUT,%DT
 | 
|---|
 | 63 |  I '$O(^SCE("ACG",0)) W !!?5,"There are no 'Computer Generated' Appointment Types which need updating." G EDITQ
 | 
|---|
 | 64 |  ;
 | 
|---|
 | 65 |  W !
 | 
|---|
 | 66 |  S DIR("A",1)="You may enter one of the following:"
 | 
|---|
 | 67 |  S DIR("A",2)="         Encounter Date - edit 'Computer Generated' entries for a specific date"
 | 
|---|
 | 68 |  S DIR("A",3)="  Patient Name (or SSN) - edit 'Computer Generated' entries for one patient"
 | 
|---|
 | 69 |  S DIR("A",4)="  The default of 'ALL'  - edit all entries which are 'Computer Generated'"
 | 
|---|
 | 70 |  S DIR("A")="Select Encounter Date"
 | 
|---|
 | 71 |  S DIR("B")="ALL"
 | 
|---|
 | 72 |  S DIR(0)="F^1:30"
 | 
|---|
 | 73 |  S %DT(0)="-DT"
 | 
|---|
 | 74 |  S DIR("?")="^D QUE^SDACSCG"
 | 
|---|
 | 75 |  D ^DIR K DIR
 | 
|---|
 | 76 |  G:$D(DIRUT) EDITQ
 | 
|---|
 | 77 |  ;
 | 
|---|
 | 78 |  S SDOUT=0
 | 
|---|
 | 79 |  D
 | 
|---|
 | 80 |  .N SDZ
 | 
|---|
 | 81 |  .I "ALLall"[Y D  Q
 | 
|---|
 | 82 |  ..D ALL
 | 
|---|
 | 83 |  .S (X,SDZ)=Y,%DT="PX"
 | 
|---|
 | 84 |  .D ^%DT
 | 
|---|
 | 85 |  .I Y'=-1 D  Q
 | 
|---|
 | 86 |  ..S Y=SDZ
 | 
|---|
 | 87 |  ..D DATE
 | 
|---|
 | 88 |  .S Y=SDZ
 | 
|---|
 | 89 |  .I Y?9N!(Y?1A4N)!(Y?.AP)!(Y?4N) D  Q
 | 
|---|
 | 90 |  ..D DPT
 | 
|---|
 | 91 |  ;
 | 
|---|
 | 92 |  I 'SDOUT G EDIT
 | 
|---|
 | 93 |  ;
 | 
|---|
 | 94 | EDITQ D EXIT
 | 
|---|
 | 95 |  Q
 | 
|---|
 | 96 |  ;
 | 
|---|
 | 97 | DATE ;
 | 
|---|
 | 98 |  N CT,%DT,Y,SDBEG,SDEND
 | 
|---|
 | 99 |  S CT=0
 | 
|---|
 | 100 |  S %DT="EPTXS"
 | 
|---|
 | 101 |  S %DT(0)=-DT
 | 
|---|
 | 102 |  D ^%DT S Y=+Y
 | 
|---|
 | 103 |  IF $D(DTOUT) S SDOUT=1 G DATEQ
 | 
|---|
 | 104 |  G DATEQ:Y=-1
 | 
|---|
 | 105 |  ;
 | 
|---|
 | 106 |  S SDBEG=$S(Y[".":Y-.000001,1:Y)
 | 
|---|
 | 107 |  S SDEND=$S(Y[".":Y,1:Y_.999999)
 | 
|---|
 | 108 |  D LOOP(SDBEG,SDEND)
 | 
|---|
 | 109 |  ;
 | 
|---|
 | 110 |  G:SDOUT DATEQ
 | 
|---|
 | 111 |  W:'CT !,"There are no 'Computer Generated' appt types for selection.",*7,!
 | 
|---|
 | 112 | DATEQ Q
 | 
|---|
 | 113 |  ;
 | 
|---|
 | 114 | ALL ; -- loop through and edit all computer generated appt types
 | 
|---|
 | 115 |  N CT
 | 
|---|
 | 116 |  S CT=0
 | 
|---|
 | 117 |  ;
 | 
|---|
 | 118 |  D LOOP()
 | 
|---|
 | 119 |  ;
 | 
|---|
 | 120 | ALLQ Q
 | 
|---|
 | 121 |  ;
 | 
|---|
 | 122 | DPT ; -- look up in patient file & loop through acg for selected dfn
 | 
|---|
 | 123 |  ;
 | 
|---|
 | 124 |  N DIC,D,CT,Y
 | 
|---|
 | 125 |  S CT=0
 | 
|---|
 | 126 |  S DIC="^DPT(",DIC(0)="EQMZ"
 | 
|---|
 | 127 |  S D=$S(X?9N:"SSN",X?1A.4N:"B5",1:"B")
 | 
|---|
 | 128 |  D IX^DIC
 | 
|---|
 | 129 |  G DPTQ:Y'>0
 | 
|---|
 | 130 |  ;
 | 
|---|
 | 131 |  D LOOP(,,+Y)
 | 
|---|
 | 132 |  ;
 | 
|---|
 | 133 |  G:SDOUT DPTQ
 | 
|---|
 | 134 |  W:'CT !,"There are no 'Computer Generated' appt types for selected entry.",*7,!
 | 
|---|
 | 135 | DPTQ Q
 | 
|---|
 | 136 |  ;
 | 
|---|
 | 137 | LOOP(SDBEG,SDEND,SDFN) ;
 | 
|---|
 | 138 |  N SDY,DFN,VA,VAERR,VAADM,SDT,SDOE
 | 
|---|
 | 139 |  ;
 | 
|---|
 | 140 |  IF '$G(SDBEG) N SDBEG S SDBEG=0
 | 
|---|
 | 141 |  IF '$G(SDEND) N SDEND S SDEND=9999999
 | 
|---|
 | 142 |  IF '$G(SDFN) N SDFN S SDFN=0
 | 
|---|
 | 143 |  ;
 | 
|---|
 | 144 |  S SDT=SDBEG
 | 
|---|
 | 145 |  F  S SDT=$O(^SCE("ACG",SDT)) Q:'SDT!(SDT>SDEND)  D  Q:SDOUT
 | 
|---|
 | 146 |  . S SDOE=0
 | 
|---|
 | 147 |  . F  S SDOE=$O(^SCE("ACG",SDT,SDOE)) Q:'SDOE  D  Q:SDOUT 
 | 
|---|
 | 148 |  . . IF SDFN,SDFN'=+$P($G(^SCE(SDOE,0)),"^",2) Q
 | 
|---|
 | 149 |  . . D DEM(SDOE),DEMW
 | 
|---|
 | 150 |  . . D DIE(SDOE)
 | 
|---|
 | 151 | LOOPQ Q
 | 
|---|
 | 152 |  ;
 | 
|---|
 | 153 | DEM(SDOE) ; -- get pt name,ssn and visit date
 | 
|---|
 | 154 |  N SDOE0,Y,DFN
 | 
|---|
 | 155 |  S SDOE0=$G(^SCE(SDOE,0))
 | 
|---|
 | 156 |  S DFN=+$P(SDOE0,"^",2)
 | 
|---|
 | 157 |  D DEM^VADPT
 | 
|---|
 | 158 |  S Y=+SDOE0 D DD^%DT S SDY=Y
 | 
|---|
 | 159 |  Q
 | 
|---|
 | 160 |  ;
 | 
|---|
 | 161 | DEMW ; -- write patient demographics
 | 
|---|
 | 162 |  W !!,SDY,?25,$S(VAERR=0:VADM(1),1:"UNKNOWN"),?60,VA("PID")
 | 
|---|
 | 163 |  Q
 | 
|---|
 | 164 |  ;
 | 
|---|
 | 165 | DIE(SDOE) ; -- do edit
 | 
|---|
 | 166 |  N DR,DIE,DE,DQ
 | 
|---|
 | 167 |  S DR=".1d;I $P(^(0),U,10)=10 S Y=""@99"";202///@;@99"
 | 
|---|
 | 168 |  S DIE="^SCE("
 | 
|---|
 | 169 |  S DA=SDOE
 | 
|---|
 | 170 |  D ^DIE
 | 
|---|
 | 171 |  S:$D(DTOUT)!($D(Y)'=0) SDOUT=1
 | 
|---|
 | 172 |  S CT=CT+1
 | 
|---|
 | 173 |  Q
 | 
|---|
 | 174 |  ;
 | 
|---|