SDCCP.m

SDCCP ;MAN/GRR - AUTO-REBOOK CANCELLED CLINIC REPORT ; 22 MAR 84  12:27 pm

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

 ;IHS/ANMC/LJF 12/06/2000 changed SSN to HRCN

 ;

 I '$D(FSW) S FSW="" D HED

 D:$Y>(IOSL-2) HED

 ;S P=^DPT(+A,0) W !!,$P(P,"^",1),?32,$E($P(P,"^",9),6,9) S X=GDATE D TM W ?37,$J(X,8) S X=NDATE D:X]"" TM S Y=NDATE D DTS^SDUTL W:NDATE]"" ?48,Y," ",$J(X,8)  ;IHS/ANMC/LJF 12/06/2000

 S P=^DPT(+A,0) W !!,$P(P,"^",1),?25,$$HRCN^BDGF2(+A,+$G(DUZ(2))) S X=GDATE D TM W ?37,$J(X,8) S X=NDATE D:X]"" TM S Y=NDATE D DTS^SDUTL W:NDATE]"" ?48,Y," ",$J(X,8)  ;IHS/ANMC/LJF 12/06/2000

 I NDATE F TST=3,4,5 S X=$P(^DPT(+A,"S",NDATE,0),"^",TST) I X]"" D TM W !,?57,$J(X,8)," ",$P("LAB^X-RAY^EKG","^",(TST-2))

 W ! S:DUPE MESS=MESS_$S(MESS]"":",",1:"")_" MULTIPLE APPNTS. ON CANCELLED DATE" W:MESS]"" !,?5,MESS,! S MESS=""

 Q

HED W @IOF,!,?22,"CANCELLED CLINIC AUTO-REBOOK REPORT",!!,"CLINIC: ",$S($D(^SC(SC,0)):$P(^(0),"^"),1:"CLINIC HAS NO NAME"),!,"CLINIC CANCELLED: " S Y=CDATE D DTS^SDUTL W Y,?54,"DATE PRINTED: " S Y=DT D DTS^SDUTL W Y

 ;W !,"PATIENT NAME",?32,"SSN",?39,"TIME",?50,"NEW DATE/TIME",!! Q  ;IHS/ANMC/LJF 12/06/2000

 W !,"PATIENT NAME",?25,"HRCN",?39,"TIME",?50,"NEW DATE/TIME",!! Q  ;IHS/ANMC/LJF 12/06/2000

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

SDCCP     ;MAN/GRR - AUTO-REBOOK CANCELLED CLINIC REPORT ; 22 MAR 84  12:27 pm

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

 +2       ;IHS/ANMC/LJF 12/06/2000 changed SSN to HRCN

 +3       ;

 +4        IF '$DATA(FSW)

               SET FSW=""

               DO HED

 +5        IF $Y>(IOSL-2)

               DO HED

 +6       ;S P=^DPT(+A,0) W !!,$P(P,"^",1),?32,$E($P(P,"^",9),6,9) S X=GDATE D TM W ?37,$J(X,8) S X=NDATE D:X]"" TM S Y=NDATE D DTS^SDUTL W:NDATE]"" ?48,Y," ",$J(X,8)  ;IHS/ANMC/LJF 12/06/2000

 +7       ;IHS/ANMC/LJF 12/06/2000

           SET P=^DPT(+A,0)

           WRITE !!,$PIECE(P,"^",1),?25,$$HRCN^BDGF2(+A,+$GET(DUZ(2)))

           SET X=GDATE

           DO TM

           WRITE ?37,$JUSTIFY(X,8)

           SET X=NDATE

           IF X]""

               DO TM

           SET Y=NDATE

           DO DTS^SDUTL

           IF NDATE]""

               WRITE ?48,Y," ",$JUSTIFY(X,8)

 +8        IF NDATE

               FOR TST=3,4,5

                   SET X=$PIECE(^DPT(+A,"S",NDATE,0),"^",TST)

                   IF X]""

                       DO TM

                       WRITE !,?57,$JUSTIFY(X,8)," ",$PIECE("LAB^X-RAY^EKG","^",(TST-2))

 +9        WRITE !

           IF DUPE

               SET MESS=MESS_$SELECT(MESS]"":",",1:"")_" MULTIPLE APPNTS. ON CANCELLED DATE"

           IF MESS]""

               WRITE !,?5,MESS,!

           SET MESS=""

 +10       QUIT 

HED        WRITE @IOF,!,?22,"CANCELLED CLINIC AUTO-REBOOK REPORT",!!,"CLINIC: ",$SELECT($DATA(^SC(SC,0)):$PIECE(^(0),"^"),1:"CLINIC HAS NO NAME"),!,"CLINIC CANCELLED: "

           SET Y=CDATE

           DO DTS^SDUTL

           WRITE Y,?54,"DATE PRINTED: "

           SET Y=DT

           DO DTS^SDUTL

           WRITE Y

 +1       ;W !,"PATIENT NAME",?32,"SSN",?39,"TIME",?50,"NEW DATE/TIME",!! Q  ;IHS/ANMC/LJF 12/06/2000

 +2       ;IHS/ANMC/LJF 12/06/2000

           WRITE !,"PATIENT NAME",?25,"HRCN",?39,"TIME",?50,"NEW DATE/TIME",!!

           QUIT 

TM         SET X=$EXTRACT($PIECE(X,".",2)_"0000",1,4)

           SET %=X>1159

           IF X>1259

               SET X=X-1200

           SET X=X\100_":"_$EXTRACT(X#100+100,2,3)_" "_$EXTRACT("AP",%+1)_"M"

           QUIT