SDNP.m

SDNP ;MAN/GRR - AUTO-REBOOK NO-SHOW CLINIC REPORT ; 22 MAR 84  12:27 pm

 ;;5.3;Scheduling;;Aug 13, 1993

 S:'$D(^UTILITY($J,+A,GDATE)) ^(GDATE)=SC_"^"_NDATE

EN1 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:Y]"" ?49,Y," ",$J(X,8) I NDATE F TST=3,4,5 S X=$P(^DPT(+A,"S",NDATE,0),"^",TST) I X]"" D TM W !,?58,$J(X,8)," ",$P("LAB^X-RAY^EKG","^",(TST-2))

 W ! S:DUPE MESS=MESS_$S(MESS]"":",",1:"")_" MULTIPLE APPTS. ON NO-SHOW DATE" W:MESS]"" !,?5,MESS,! W:$D(MESS1) ?5,MESS1,! K MESS1 S MESS=""

 Q

HED S Y=CDATE D DTS^SDUTL S Y1=Y,Y=DT D DTS^SDUTL W @IOF,?27,"NO-SHOW AUTO-REBOOK REPORT",!!,"NO-SHOW CLINIC : ",$P(^SC(+SC,0),"^",1),!,"DATE OF NO-SHOW: ",Y1,?30,"DATE PRINTED: ",Y,!

 W !,"PATIENT NAME",?32,"SSN",?39,"TIME",?50,"NEW DATE/TIME" 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDNP   999     printed  Apr 09, 2024@21:50:54                                                                                                                                                                                                         Page 2

SDNP      ;MAN/GRR - AUTO-REBOOK NO-SHOW CLINIC REPORT ; 22 MAR 84  12:27 pm

 +1       ;;5.3;Scheduling;;Aug 13, 1993

 +2        if '$DATA(^UTILITY($JOB,+A,GDATE))

               SET ^(GDATE)=SC_"^"_NDATE

EN1        IF '$DATA(FSW)

               SET FSW=""

               DO HED

 +1        if $Y>(IOSL-2)

               DO HED

 +2        SET P=^DPT(+A,0)

           WRITE !!,$PIECE(P,"^",1),?32,$EXTRACT($PIECE(P,"^",9),6,9)

           SET X=GDATE

           DO TM

           WRITE ?37,$JUSTIFY(X,8)

           SET X=NDATE

           if X]""

               DO TM

 +3        SET Y=NDATE

           DO DTS^SDUTL

           if Y]""

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

           IF NDATE

               FOR TST=3,4,5

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

                   IF X]""

                       DO TM

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

 +4        WRITE !

           if DUPE

               SET MESS=MESS_$SELECT(MESS]"":",",1:"")_" MULTIPLE APPTS. ON NO-SHOW DATE"

           if MESS]""

               WRITE !,?5,MESS,!

           if $DATA(MESS1)

               WRITE ?5,MESS1,!

           KILL MESS1

           SET MESS=""

 +5        QUIT 

HED        SET Y=CDATE

           DO DTS^SDUTL

           SET Y1=Y

           SET Y=DT

           DO DTS^SDUTL

           WRITE @IOF,?27,"NO-SHOW AUTO-REBOOK REPORT",!!,"NO-SHOW CLINIC : ",$PIECE(^SC(+SC,0),"^",1),!,"DATE OF NO-SHOW: ",Y1,?30,"DATE PRINTED: ",Y,!

 +1        WRITE !,"PATIENT NAME",?32,"SSN",?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