- 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
