source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SD53P389.m@ 1710

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

initial load of WorldVistAEHR

File size: 908 bytes
RevLine 
[613]1SD53P389 ;;BP OIFO/RJV Fix ASDCN xref.
2 ;;5.3;Scheduling;**389**;Aug 13, 1993
3 ;
4 ;Routine to loop thru appointments and if no xref for
5 ;cancelled, create it.
6 ;
7 Q
8CHK ;
9 N STATUS,SC,SDDFN,SDAPDTE
10 S SDDFN=0,STATUS="",SC=""
11 F S SDDFN=$O(^DPT(SDDFN)) Q:+SDDFN=0 D
12 .S SDAPDTE=0 F S SDAPDTE=$O(^DPT(SDDFN,"S",SDAPDTE)) Q:SDAPDTE="" D
13 ..S SC=$P(^DPT(SDDFN,"S",SDAPDTE,0),"^",1)
14 ..S STATUS=$P(^DPT(SDDFN,"S",SDAPDTE,0),"^",2)
15 ..I STATUS["C",'$D(^DPT("ASDCN",SC,SDAPDTE,SDDFN)) D
16 ...W !,SDDFN_" - "_SDAPDTE_" - "_SC
17 Q
18ASDCN ;
19 N STATUS,SC,SDDFN,SDAPDTE
20 S SDDFN=0,STATUS="",SC=""
21 F S SDDFN=$O(^DPT(SDDFN)) Q:+SDDFN=0 D
22 .S SDAPDTE=0 F S SDAPDTE=$O(^DPT(SDDFN,"S",SDAPDTE)) Q:SDAPDTE="" D
23 ..S SC=$P(^DPT(SDDFN,"S",SDAPDTE,0),"^",1)
24 ..S STATUS=$P(^DPT(SDDFN,"S",SDAPDTE,0),"^",2)
25 ..I STATUS["C",'$D(^DPT("ASDCN",SC,SDAPDTE,SDDFN)) D
26 ...S ^DPT("ASDCN",SC,SDAPDTE,SDDFN)=$S(STATUS["P":1,1:"")
27 Q
Note: See TracBrowser for help on using the repository browser.