source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDACSCG.m@ 1789

Last change on this file since 1789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1SDACSCG ;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
5CK ; -- 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 ;
18PRINT ;print those CG types which need to be manually updated
19 S DGPGM="QUE^SDACSCG"
20 D ZIS^DGUTQ
21 Q:POP
22 ;
23QUE ; -- 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 ;
41EXIT ; -- 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 ;
47CR ; -- 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 ;
56HDR ; -- 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 ;
61EDIT ; -- 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 ;
94EDITQ D EXIT
95 Q
96 ;
97DATE ;
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,!
112DATEQ Q
113 ;
114ALL ; -- loop through and edit all computer generated appt types
115 N CT
116 S CT=0
117 ;
118 D LOOP()
119 ;
120ALLQ Q
121 ;
122DPT ; -- 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,!
135DPTQ Q
136 ;
137LOOP(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)
151LOOPQ Q
152 ;
153DEM(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 ;
161DEMW ; -- write patient demographics
162 W !!,SDY,?25,$S(VAERR=0:VADM(1),1:"UNKNOWN"),?60,VA("PID")
163 Q
164 ;
165DIE(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 ;
Note: See TracBrowser for help on using the repository browser.