Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDCNP2

SDCNP2.m

Go to the documentation of this file.
SDCNP2 ;ALB/LDB - PRINT CANCELLED AND AUTO REBOOKED APPTS. REPORT ; 14 MAR 88@13:00
 ;;5.3;Scheduling;;Aug 13, 1993
 ;
 U IO S (SDEND,SDLN,SDLN1,SDLN2)="",SDPT=^DPT(+A,0),SD1=$P(SDPT,"^"),SD2=$P(SDPT,"^",9)
 D HDR
 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
CL 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
 D:$D(SDIO) OUT Q:SDEND
 Q
HDR 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"
 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
APPT 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
 W ! Q
TM 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
OUT W *7 I ($Y+4)<IOSL F SDXX=$Y:1:IOSL-4 W !
 R !,"PRESS RETURN TO CONTINUE",X:DTIME S SDEND=1 S:'$T SDEND=1 Q
TST 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)
 W ! Q