SDCNP2.m

SDCNP2 ;ALB/LDB - PRINT CANCELLED AND AUTO REBOOKED APPTS. REPORT ; 14 MAR 88@13:00

 ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21

 ;             12/06/2000 changed SSN to HRCN

 ;

 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"  ;IHS/ANMC/LJF 12/06/2000

 W @IOF,?23,"CANCELLED AND AUTO-REBOOKED REPORT",?65 S X="T",Y="" D ^%DT,DT^DIQ W !,?23,"FOR:",?30,SD1,!,?23,"HRCN: ",?30,SD2,!,?14,"CANCELLED BY:",?30,$S(DUZ:$P(^VA(200,DUZ,0),"^",1),1:"UNKNOWN"),!!,"CLINIC"   ;IHS/ANMC/LJF 12/06/2000

 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

SDCNP2    ;ALB/LDB - PRINT CANCELLED AND AUTO REBOOKED APPTS. REPORT ; 14 MAR 88@13:00

 +1       ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21

 +2       ;             12/06/2000 changed SSN to HRCN

 +3       ;

 +4        USE IO

           SET (SDEND,SDLN,SDLN1,SDLN2)=""

           SET SDPT=^DPT(+A,0)

           SET SD1=$PIECE(SDPT,"^")

           SET SD2=$PIECE(SDPT,"^",9)

 +5        DO HDR

 +6        FOR APPZ=0:0