SDC1 ;ALB/GRR - PRINT CLINIC PRE-CANCELLATION LIST ; 6/30/05 10:15am
;;5.3;PIMS;**379,398,439,478,1015,1016**;JUN 30, 2012;Build 20
;IHS/ANMC/LJF 11/30/2000 changed $N to $O
; 12/13/2000 added date to report heading
K ^TMP("SDC1",$J) S DGVAR="SD^SC^SDTIME",DGPGM="START^SDC1" D ZIS^DGUTQ Q:POP
START U IO S SDCNT=0 K DUOUT,DTOUT N SDBADD,SNODE S SDBADD=0,SNODE=""
; sd*5.3*439 FOR loop changed to exclude if different clinic
F J=SD:0 S J=$O(^SC(SC,"S",J)) Q:J=""!(J\1-SD)!$D(DTOUT)!$D(DUOUT) D
. S J2=0 F S J2=$O(^SC(SC,"S",J,1,J2)) Q:J2=""!$D(DTOUT)!$D(DUOUT) D
.. I '$D(^SC(SC,"S",J,1,J2,0)) I $D(^("C")) D DELETE Q ;SD*545 if corrupt node delete
.. I '+$G(^SC(SC,"S",J,1,J2,0)) D DELETE Q ;SD*545 if DFN missing delete record
.. S DFN=+^SC(SC,"S",J,1,J2,0),SDLE=$P(^(0),U,2)
.. Q:'$D(^DPT(DFN,"S",J,0)) S SNODE=^(0)
.. Q:$P(SNODE,U,1)'=SC&($P(SNODE,U,14)'=SDTIME)
.. I $P(SNODE,U,2)'["C"!($P(SNODE,U,14)=SDTIME) D PLST Q:$D(DTOUT)!$D(DUOUT)
G:$D(DUOUT)!$D(DTOUT) EXIT I SDCNT=0 S NOAP=1 W !,"NO APPOINTMENTS SCHEDULED"
I SDBADD D
. W !!,"* THIS PATIENT HAS BEEN FLAGGED WITH A BAD ADDRESS INDICATOR, NO LETTER"
. W !,"WILL BE PRINTED."
I $E(IOST,1,2)'="C-" W @IOF
EXIT K DUOUT,DTOUT,I,J,J2,X,DFN,SNODE,SDLE,SDCNT,^TMP("SDC1",$J) W !! D CLOSE^DGUTQ Q ; sd*5.3*439 added local vars to kill
PLST I SDCNT=0!($Y+2>IOSL) S DIR(0)="E" D:$E(IOST,1,2)="C-" ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT) D HED
;
;CHECK FOR DUPLICATE ENTRY IN FILE 44 - SD*5.3*379
;
I $D(^TMP("SDC1",$J,J,DFN)) Q
S ^TMP("SDC1",$J,J,DFN)=""
;
N VA D PID^VADPT6
N CSLNK S CSLNK=$P($G(^SC(SC,"S",J,1,J2,"CONS")),U) ;SD/478
W ! I $$BADADR^DGUTL3(+DFN) W "*" S SDBADD=1
W $P(^DPT(DFN,0),"^",1),?30,VA("PID") S X=J D TM^SDROUT0 W ?43,$J(X,8),?52,$S(CSLNK'="":"CONS",1:""),?58,SDLE W:$D(^DPT(DFN,.13)) ?64,$P(^(.13),"^",1) ;SD/478
S SDCNT=SDCNT+1 Q
HED ;W @IOF,!,$P(^SC(SC,0),"^",1)," Clinic Pre-cancellation list",!,"PATIENT NAME",?34,"ID",?43,"APPT TIME",?56,"LENGTH",?64,"TELEPHONE" ;IHS/ANMC/.LJF 12/13/2000
W @IOF,!,$P(^SC(SC,0),"^",1)," Clinic Pre-cancellation list for ",$$FMTE^XLFDT(SD,"D"),!,"PATIENT NAME",?34,"ID",?43,"APPT TIME",?56,"LENGTH",?64,"TELEPHONE" ;IHS/ANMC/LJF 12/13/2000
W ! F I=1:1:79 W "-"
Q
;
DELETE ;SD*5.3*545 when applicable, delete corrupt appt sub-record
S DA(2)=SC,DA(1)=J,DA=J2
S DIK="^SC("_DA(2)_",""S"","_DA(1)_",1," D ^DIK
K DA,DIK
Q
SDC1 ;ALB/GRR - PRINT CLINIC PRE-CANCELLATION LIST ; 6/30/05 10:15am
+1 ;;5.3;PIMS;**379,398,439,478,1015,1016**;JUN 30, 2012;Build 20
+2 ;IHS/ANMC/LJF 11/30/2000 changed $N to $O
+3 ; 12/13/2000 added date to report heading
+4 KILL ^TMP("SDC1",$JOB)
SET DGVAR="SD^SC^SDTIME"
SET DGPGM="START^SDC1"
DO ZIS^DGUTQ
IF POP
QUIT
START USE IO
SET SDCNT=0
KILL DUOUT,DTOUT
NEW SDBADD,SNODE
SET SDBADD=0
SET SNODE=""
+1 ; sd*5.3*439 FOR loop changed to exclude if different clinic
+2 FOR J=SD:0
SET J=$ORDER(^SC(SC,"S",J))
IF J=""!(J\1-SD)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
Begin DoDot:1
+3 SET J2=0
FOR
SET J2=$ORDER(^SC(SC,"S",J,1,J2))
IF J2=""!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
Begin DoDot:2
+4 ;SD*545 if corrupt node delete
IF '$DATA(^SC(SC,"S",J,1,J2,0))
IF $DATA(^("C"))
DO DELETE
QUIT
+5 ;SD*545 if DFN missing delete record
IF '+$GET(^SC(SC,"S",J,1,J2,0))
DO DELETE
QUIT
+6 SET DFN=+^SC(SC,"S",J,1,J2,0)
SET SDLE=$PIECE(^(0),U,2)
+7 IF '$DATA(^DPT(DFN,"S",J,0))
QUIT
SET SNODE=^(0)
+8 IF $PIECE(SNODE,U,1)'=SC&($PIECE(SNODE,U,14)'=SDTIME)
QUIT
+9 IF $PIECE(SNODE,U,2)'["C"!($PIECE(SNODE,U,14)=SDTIME)
DO PLST
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
End DoDot:2
End DoDot:1
+10 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT
IF SDCNT=0
SET NOAP=1
WRITE !,"NO APPOINTMENTS SCHEDULED"
+11 IF SDBADD
Begin DoDot:1
+12 WRITE !!,"* THIS PATIENT HAS BEEN FLAGGED WITH A BAD ADDRESS INDICATOR, NO LETTER"
+13 WRITE !,"WILL BE PRINTED."
End DoDot:1
+14 IF $EXTRACT(IOST,1,2)'="C-"
WRITE @IOF
EXIT ; sd*5.3*439 added local vars to kill
KILL DUOUT,DTOUT,I,J,J2,X,DFN,SNODE,SDLE,SDCNT,^TMP("SDC1",$JOB)
WRITE !!
DO CLOSE^DGUTQ
QUIT
PLST IF SDCNT=0!($Y+2>IOSL)
SET DIR(0)="E"
IF $EXTRACT(IOST,1,2)="C-"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
DO HED
+1 ;
+2 ;CHECK FOR DUPLICATE ENTRY IN FILE 44 - SD*5.3*379
+3 ;
+4 IF $DATA(^TMP("SDC1",$JOB,J,DFN))
QUIT
+5 SET ^TMP("SDC1",$JOB,J,DFN)=""
+6 ;
+7 NEW VA
DO PID^VADPT6
+8 ;SD/478
NEW CSLNK
SET CSLNK=$PIECE($GET(^SC(SC,"S",J,1,J2,"CONS")),U)
+9 WRITE !
IF $$BADADR^DGUTL3(+DFN)
WRITE "*"
SET SDBADD=1
+10 ;SD/478
WRITE $PIECE(^DPT(DFN,0),"^",1),?30,VA("PID")
SET X=J
DO TM^SDROUT0
WRITE ?43,$JUSTIFY(X,8),?52,$SELECT(CSLNK'="":"CONS",1:""),?58,SDLE
IF $DATA(^DPT(DFN,.13))
WRITE ?64,$PIECE(^(.13),"^",1)
+11 SET SDCNT=SDCNT+1
QUIT
HED ;W @IOF,!,$P(^SC(SC,0),"^",1)," Clinic Pre-cancellation list",!,"PATIENT NAME",?34,"ID",?43,"APPT TIME",?56,"LENGTH",?64,"TELEPHONE" ;IHS/ANMC/.LJF 12/13/2000
+1 ;IHS/ANMC/LJF 12/13/2000
WRITE @IOF,!,$PIECE(^SC(SC,0),"^",1)," Clinic Pre-cancellation list for ",$$FMTE^XLFDT(SD,"D"),!,"PATIENT NAME",?34,"ID",?43,"APPT TIME",?56,"LENGTH",?64,"TELEPHONE"
+2 WRITE !
FOR I=1:1:79
WRITE "-"
+3 QUIT
+4 ;
DELETE ;SD*5.3*545 when applicable, delete corrupt appt sub-record
+1 SET DA(2)=SC
SET DA(1)=J
SET DA=J2
+2 SET DIK="^SC("_DA(2)_",""S"","_DA(1)_",1,"
DO ^DIK
+3 KILL DA,DIK
+4 QUIT
