source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDC1.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1SDC1 ;ALB/GRR - PRINT CLINIC PRE-CANCELLATION LIST ; 6/30/05 10:15am
2 ;;5.3;Scheduling;**379,398,439,478**;Aug 13, 1993
3 K ^TMP("SDC1",$J) S DGVAR="SD^SC^SDTIME",DGPGM="START^SDC1" D ZIS^DGUTQ Q:POP
4START U IO S SDCNT=0 K DUOUT,DTOUT N SDBADD,SNODE S SDBADD=0,SNODE=""
5 ; sd*5.3*439 FOR loop changed to exclude if different clinic
6 F J=SD:0 S J=$O(^SC(SC,"S",J)) Q:J=""!(J\1-SD)!$D(DTOUT)!$D(DUOUT) D
7 . S J2=0 F S J2=$O(^SC(SC,"S",J,1,J2)) Q:J2=""!$D(DTOUT)!$D(DUOUT) D
8 .. S DFN=+^SC(SC,"S",J,1,J2,0),SDLE=$P(^(0),U,2)
9 .. Q:'$D(^DPT(DFN,"S",J,0)) S SNODE=^(0)
10 .. Q:$P(SNODE,U,1)'=SC&($P(SNODE,U,14)'=SDTIME)
11 .. I $P(SNODE,U,2)'["C"!($P(SNODE,U,14)=SDTIME) D PLST Q:$D(DTOUT)!$D(DUOUT)
12 G:$D(DUOUT)!$D(DTOUT) EXIT I SDCNT=0 S NOAP=1 W !,"NO APPOINTMENTS SCHEDULED"
13 I SDBADD D
14 . W !!,"* THIS PATIENT HAS BEEN FLAGGED WITH A BAD ADDRESS INDICATOR, NO LETTER"
15 . W !,"WILL BE PRINTED."
16 I $E(IOST,1,2)'="C-" W @IOF
17EXIT K DUOUT,DTOUT,I,J,J2,X,DFN,SNODE,SDLE,SDCNT,^TMP("SDC1",$J) W !! D CLOSE^DGUTQ Q ; sd*5.3*439 added local vars to kill
18PLST I SDCNT=0!($Y+2>IOSL) S DIR(0)="E" D:$E(IOST,1,2)="C-" ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT) D HED
19 ;
20 ;CHECK FOR DUPICATE ENTRY IN FILE 44 - SD*5.3*379
21 ;
22 I $D(^TMP("SDC1",$J,J,DFN)) Q
23 S ^TMP("SDC1",$J,J,DFN)=""
24 ;
25 N VA D PID^VADPT6
26 N CSLNK S CSLNK=$P($G(^SC(SC,"S",J,1,J2,"CONS")),U) ;SD/478
27 W ! I $$BADADR^DGUTL3(+DFN) W "*" S SDBADD=1
28 W $P(^DPT(DFN,0),"^",1),?30,VA("PID") S X=J D TM^SDROUT0 W ?43,$J(X,8),?52,$S(CSLNK'="":"CONS",1:""),?58,SDLE W:$D(^DPT(DFN,.13)) ?64,$P(^(.13),"^",1) ;SD/478
29 S SDCNT=SDCNT+1 Q
30HED W @IOF,!,$P(^SC(SC,0),"^",1)," Clinic Pre-cancellation list",!,"PATIENT NAME",?34,"ID",?43,"APPT TIME",?56,"LENGTH",?64,"TELEPHONE"
31 W ! F I=1:1:79 W "-"
32 Q
Note: See TracBrowser for help on using the repository browser.