source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDCNP2.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 1.5 KB
Line 
1SDCNP2 ;ALB/LDB - PRINT CANCELLED AND AUTO REBOOKED APPTS. REPORT ; 14 MAR 88@13:00
2 ;;5.3;Scheduling;;Aug 13, 1993
3 ;
4 U IO S (SDEND,SDLN,SDLN1,SDLN2)="",SDPT=^DPT(+A,0),SD1=$P(SDPT,"^"),SD2=$P(SDPT,"^",9)
5 D HDR
6 F APPZ=0:0 S APPZ=$N(SDCL(APPZ)) Q:APPZ'>0 S SC=$P(SDCL(APPZ),"^",1),GDATE=$P(SDCL(APPZ),"^",2),NDATE=$P(SDCL(APPZ),"^",3),^UTILITY($J,"SDCNP3",+A,SC,GDATE)=NDATE
7CL F SDP=0:0 S SDP=$N(^UTILITY($J,"SDCNP3",+A,SDP)) Q:SDP'>0 D:$Y+6>IOSL&($D(SDIO)) OUT D:$Y+6>IOSL HDR W !,$E($P(^SC(SDP,0),"^"),1,25) S SDT1=0 D APPT
8 D:$D(SDIO) OUT Q:SDEND
9 Q
10HDR W @IOF,?23,"CANCELLED AND AUTO-REBOOKED REPORT",?65 S X="T",Y="" D ^%DT,DT^DIQ W !,?23,"FOR:",?30,SD1,!,?23,"SSN: ",?30,SD2,!,?14,"CANCELLED BY:",?30,$S(DUZ:$P(^VA(200,DUZ,0),"^",1),1:"UNKNOWN"),!!,"CLINIC"
11 W ?25,"CANCELLED APPT.",?55,"NEW DATE" S $P(SDLN,"=",7)="" W !,SDLN S $P(SDLN1,"=",15)="" W ?25,SDLN1 S $P(SDLN2,"=",13)="" W ?55,SDLN2,! Q
12APPT F X3=0:0 S SDT1=$N(^UTILITY($J,"SDCNP3",+A,SDP,SDT1)) Q:SDT1'>0 W ?25 S X=SDT1,Y=$P(SDT1,".") D D^DIQ,TM W Y," at ",$J(X,8),?55 S:^(SDT1) X=^(SDT1),Y=$P(^(SDT1),".") D D^DIQ,TM W $S(^(SDT1):Y_" at "_$J(X,8),1:"NOT REBOOKED") D:^(SDT1) TST
13 W ! Q
14TM S X=$E($P(X,".",2)_"0000",1,4),%=X>1159 S:X>1259 X=X-1200 S X=X\100_":"_$E(X#100+100,2,3)_" "_$E("AP",%+1)_"M" Q
15OUT W *7 I ($Y+4)<IOSL F SDXX=$Y:1:IOSL-4 W !
16 R !,"PRESS RETURN TO CONTINUE",X:DTIME S SDEND=1 S:'$T SDEND=1 Q
17TST S SDT20=^UTILITY($J,"SDCNP3",+A,SDP,SDT1) F TST=3,4,5 S X=$P(^DPT(+A,"S",SDT20,0),"^",TST) I X]"" D TM W !,?65,$P("LAB^X-RAY^EKG","^",(TST-2))," ",?71,$J(X,8)
18 W ! Q
Note: See TracBrowser for help on using the repository browser.