SDNOS0 ;ALB/LDB - NO SHOW REPORT ; 07 May 99 10:21 AM
 ;;5.3;Scheduling;**20,194,410,517,523,572**;Aug 13, 1993;Build 13
 D END1^SDNOS
 S (SDV1,SDIN,SDNM,SDNM1)=0,SDDIVO=SDDIV
 I $D(^DG(43,1,"GL")),$P(^("GL"),U,2) S SDV1=1
 I SDDIV'="A" S (^UTILITY($J,"SDNO",SDDIV,"***TOT***"),^UTILITY($J,"SDNO",SDDIV,"***N***","***TOT***"),^UTILITY($J,"SDNO",SDDIV,"***NA***","***TOT***"),^UTILITY($J,"SDNO",SDDIV,"***SDNMS***"))=0
 I SDDIV="A" D DIVRPT
 I SDCL(1)="ALL" S SDCL=0 D SDCL
 I SDCL(1)'="ALL" F SDSUB=0:0 S SDSUB=$O(SDCL(SDSUB)) Q:SDSUB=""  S SDCL=SDCL(SDSUB),SDLAB=$S(SDCL?.N1"*".E:"RANGE",1:"SDTST") D @SDLAB
 S (P1,SDTOT,SDTOT1)=0,DGTCH="NO-SHOW REPORT^CLINIC^PAGE#",(SDEND,SDHD)=0
 D ^SDNOS1
 Q
 ;
DIVRPT F SDDIV=0:0 S SDDIV=$O(^DG(40.8,SDDIV)) Q:'SDDIV  S (^UTILITY($J,"SDNO",SDDIV,"***N***","***TOT***"),^UTILITY($J,"SDNO",SDDIV,"***NA***","***TOT***"),^UTILITY($J,"SDNO",SDDIV,"***TOT***"),^UTILITY($J,"SDNO",SDDIV,"***SDNMS***"))=0
 Q
 ;
SDCL F SDZ=1:1 S SDCL=$O(^SC(SDCL)) Q:'SDCL  D SDTST
 Q
 ;
SDTST S SDNM=0,SDCL1=^SC(SDCL,0) I $P(SDCL1,U,3)'="C" Q
 I SDDIVO,SDCL(1),'$D(SDR1) D DATES Q
 I $S((SDDIVO&'SDCL(1)&(SDDIVO=$P(SDCL1,U,15))):1,'SDDIVO:1,$D(SDR1)&SDDIVO&($P(SDCL1,U,15)=SDDIVO):1,'$P(SDCL1,U,15)&(SDDIVO=$P(^DG(43,1,"GL"),U,3)):1,'SDV1:1,1:0) S SDIN=0 D:$D(^SC(SDCL,"I")) INAC^SDNOS1A Q:SDIN  D DATES
 Q
 ;
DATES S:'SDDIVO SDDIV=$S($P(SDCL1,U,15)&SDV1:$P(SDCL1,U,15),$D(^DG(43,"GL")):$P(^("GL"),U,3),1:$O(^DG(40.8,0)))
 Q:$D(^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***TOT***"))  S ^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***TOT***")=0,^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***SDNMS***")=0
 S (SDEN,SDBEG)=0,SDBEG1=SDBD F SDZ1=1:1 S SDBEG1=$O(^SC(SDCL,"S",SDBEG1)) Q:SDBEG1'>0  D SDED Q:SDBEG!SDEN  D CHK
 S ^UTILITY($J,"SDNO",SDDIV,"***SDNMS***")=SDNM+^UTILITY($J,"SDNO",SDDIV,"***SDNMS***")
 Q
 ;
SDED S SDBEG=0,SDEN=0 I $D(SDED),(SDBEG1>(SDED+.99999)) S SDEN=1 Q
 I '$D(SDED),(SDBEG1>(SDBD+.99999)) S SDBEG=1 Q
 Q
 ;Added 2nd Quit below SD/517
 ;SD/523 - added Q:SDPAT="" to For loop
CHK S SDAPP=0 F  S SDAPP=$O(^SC(SDCL,"S",SDBEG1,1,SDAPP)) Q:'SDAPP  Q:'$D(^(SDAPP,0))  I $D(^SC(SDCL,"S",SDBEG1,1,SDAPP))=10,$P(^(SDAPP,0),U,9)'="C" S SDPAT=$P(^SC(SDCL,"S",SDBEG1,1,SDAPP,0),U,1) Q:SDPAT=""  I $D(^DPT(SDPAT,"S",SDBEG1)) D CHK1
 Q
 ;
CHK1 S SD="SD" F SDCHK=1,2,10,12,14 S @(SD_SDCHK)=$P(^DPT(SDPAT,"S",SDBEG1,0),U,SDCHK)
 S:'SDDIVO&$P(SDCL1,U,15) SDDIV=$P(SDCL1,U,15) S:'SDDIVO&'$P(SDCL1,U,15) SDDIV=$O(^DG(40.8,0))
 S:'$D(^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***TOT***")) ^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***TOT***")=0
 I SDFMT=1 D
 .I (SD2="N")!(SD2="NA"),$$NOSHOW(SDPAT,SDBEG1,SDCL,$G(^DPT(SDPAT,"S",SDBEG1,0)),SDAPP) D 
 ..D SET,TOTAL Q
 I SDFMT=2 D
 .I (SD2=""&('$D(^SC(SDCL,"S",SDBEG1,1,SDAPP,"C"))))!(SD2="N")!(SD2="NA")!(SD2="NT"),$$NOSHOW(SDPAT,SDBEG1,SDCL,$G(^DPT(SDPAT,"S",SDBEG1,0)),SDAPP) D
 ..D SET Q:SD2=""  D TOTAL Q    ;SD*572 only count No Show appts
 I SD2'["C" S SDNM=SDNM+1,^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***SDNMS***")=SDNM
 Q
 ;
SET S:$P(SDCL1,U,15)&SDDIVO&SDV1 SDDIV=$P(SDCL1,U,15) S ^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),SDBEG1,$P(^DPT(SDPAT,0),U),+$P(^(0),U,9))=SD2_U_SD10_U_SD12
 Q
 ;
TOTAL S ^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***"_SD2_"***","***TOT***")=$S($D(^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***"_SD2_"***","***TOT***")):^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***"_SD2_"***","***TOT***")+1,1:1)
 S ^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),$P(SDBEG1,"."),"***"_SD2_"***","***TOT***")=$S($D(^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),$P(SDBEG1,"."),"***"_SD2_"***","***TOT***")):^("***TOT***")+1,1:1)
 S ^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***TOT***")=$S($D(^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***TOT***")):^UTILITY($J,"SDNO",SDDIV,$P(SDCL1,U),"***TOT***")+1,1:1)
 S ^("***TOT***")=^UTILITY($J,"SDNO",SDDIV,"***TOT***")+1,^("***TOT***")=$S($D(^UTILITY($J,"SDNO",SDDIV,"***"_SD2_"***","***TOT***")):^UTILITY($J,"SDNO",SDDIV,"***"_SD2_"***","***TOT***")+1,1:1)
 Q
 ;
RANGE S SDREST=$E(SDCL,$F(SDCL,"*"),$L(SDCL)),SDCL=$E(SDCL,1,($F(SDCL,"*")-2)),SDCL1=^SC(SDCL,0)
 S:'SDDIVO SDDIV=$S($P(SDCL1,U,15):$P(SDCL1,U,15),'$P(SDCL1,U,15)&$D(^DG(43,"GL")):$P(^DG(43,"GL"),U,3),1:$O(^DG(40.8,0)))
 S SDR1=1,SDR=$P(SDCL1,U) D SDTST K SDR1
 S SDREST="1"_""""_SDREST_""""_".E" F SDCXX=1:1 S SDR=$O(^SC("B",SDR)) Q:'(SDR?@SDREST)!(SDR="")  S SDCL=$O(^SC("B",SDR,-1)) S SDR1=1 D RANGE1 K SDR1
 Q
 ;
RANGE1 S:'SDDIVO SDDIV=$S($P(SDCL1,U,15):$P(SDCL1,U,15),'$P(SDCL1,U,15)&$D(^DG(43,"GL")):$P(^DG(43,"GL"),U,3),1:$O(^DG(40.8,0))) D SDTST
 Q
 ;
NOSHOW(DFN,SDT,CIFN,PAT,DA) ;Input:  DFN=Patient IFN, SDT=Appointment D/T
 ;  CIFN=Clinic IFN, PAT=Zero node of pat. appt., DA=Clinic appt. IFN
 ;                        Output:  1 or 0 for noshow yes/no
 N NSQUERY,NS S NS=1,NSQUERY=$$STATUS^SDAM1(DFN,SDT,CIFN,PAT,DA)
 I $P(NSQUERY,";",3)["ACTION REQ" S NS=0
NOSHOWQ Q NS
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDNOS0   4879     printed  Sep 23, 2025@20:35:46                                                                                                                                                                                                      Page 2
SDNOS0    ;ALB/LDB - NO SHOW REPORT ; 07 May 99 10:21 AM
 +1       ;;5.3;Scheduling;**20,194,410,517,523,572**;Aug 13, 1993;Build 13
 +2        DO END1^SDNOS
 +3        SET (SDV1,SDIN,SDNM,SDNM1)=0
           SET SDDIVO=SDDIV
 +4        IF $DATA(^DG(43,1,"GL"))
               IF $PIECE(^("GL"),U,2)
                   SET SDV1=1
 +5        IF SDDIV'="A"
               SET (^UTILITY($JOB,"SDNO",SDDIV,"***TOT***"),^UTILITY($JOB,"SDNO",SDDIV,"***N***","***TOT***"),^UTILITY($JOB,"SDNO",SDDIV,"***NA***","***TOT***"),^UTILITY($JOB,"SDNO",SDDIV,"***SDNMS***"))=0
 +6        IF SDDIV="A"
               DO DIVRPT
 +7        IF SDCL(1)="ALL"
               SET SDCL=0
               DO SDCL
 +8        IF SDCL(1)'="ALL"
               FOR SDSUB=0:0
                   SET SDSUB=$ORDER(SDCL(SDSUB))
                   if SDSUB=""
                       QUIT 
                   SET SDCL=SDCL(SDSUB)
                   SET SDLAB=$SELECT(SDCL?.N1"*".E:"RANGE",1:"SDTST")
                   DO @SDLAB
 +9        SET (P1,SDTOT,SDTOT1)=0
           SET DGTCH="NO-SHOW REPORT^CLINIC^PAGE#"
           SET (SDEND,SDHD)=0
 +10       DO ^SDNOS1
 +11       QUIT 
 +12      ;
DIVRPT     FOR SDDIV=0:0
               SET SDDIV=$ORDER(^DG(40.8,SDDIV))
               if 'SDDIV
                   QUIT 
               SET (^UTILITY($JOB,"SDNO",SDDIV,"***N***","***TOT***"),^UTILITY($JOB,"SDNO",SDDIV,"***NA***","***TOT***"),^UTILITY($JOB,"SDNO",SDDIV,"***TOT***"),^UTILITY($JOB,"SDNO",SDDIV,"***SDNMS***"))=0
 +1        QUIT 
 +2       ;
SDCL       FOR SDZ=1:1
               SET SDCL=$ORDER(^SC(SDCL))
               if 'SDCL
                   QUIT 
               DO SDTST
 +1        QUIT 
 +2       ;
SDTST      SET SDNM=0
           SET SDCL1=^SC(SDCL,0)
           IF $PIECE(SDCL1,U,3)'="C"
               QUIT 
 +1        IF SDDIVO
               IF SDCL(1)
                   IF '$DATA(SDR1)
                       DO DATES
                       QUIT 
 +2        IF $SELECT((SDDIVO&'SDCL(1)&(SDDIVO=$PIECE(SDCL1,U,15))):1,'SDDIVO:1,$DATA(SDR1)&SDDIVO&($PIECE(SDCL1,U,15)=SDDIVO):1,'$PIECE(SDCL1,U,15)&(SDDIVO=$PIECE(^DG(43,1,"GL"),U,3)):1,'SDV1:1,1:0)
               SET SDIN=0
               if $DATA(^SC(SDCL,"I"))
                   DO INAC^SDNOS1A
               if SDIN
                   QUIT 
               DO DATES
 +3        QUIT 
 +4       ;
DATES      if 'SDDIVO
               SET SDDIV=$SELECT($PIECE(SDCL1,U,15)&SDV1:$PIECE(SDCL1,U,15),$DATA(^DG(43,"GL")):$PIECE(^("GL"),U,3),1:$ORDER(^DG(40.8,0)))
 +1        if $DATA(^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***TOT***"))
               QUIT 
           SET ^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***TOT***")=0
           SET ^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***SDNMS***")=0
 +2        SET (SDEN,SDBEG)=0
           SET SDBEG1=SDBD
           FOR SDZ1=1:1
               SET SDBEG1=$ORDER(^SC(SDCL,"S",SDBEG1))
               if SDBEG1'>0
                   QUIT 
               DO SDED
               if SDBEG!SDEN
                   QUIT 
               DO CHK
 +3        SET ^UTILITY($JOB,"SDNO",SDDIV,"***SDNMS***")=SDNM+^UTILITY($JOB,"SDNO",SDDIV,"***SDNMS***")
 +4        QUIT 
 +5       ;
SDED       SET SDBEG=0
           SET SDEN=0
           IF $DATA(SDED)
               IF (SDBEG1>(SDED+.99999))
                   SET SDEN=1
                   QUIT 
 +1        IF '$DATA(SDED)
               IF (SDBEG1>(SDBD+.99999))
                   SET SDBEG=1
                   QUIT 
 +2        QUIT 
 +3       ;Added 2nd Quit below SD/517
 +4       ;SD/523 - added Q:SDPAT="" to For loop
CHK        SET SDAPP=0
           FOR 
               SET SDAPP=$ORDER(^SC(SDCL,"S",SDBEG1,1,SDAPP))
               if 'SDAPP
                   QUIT 
               if '$DATA(^(SDAPP,0))
                   QUIT 
               IF $DATA(^SC(SDCL,"S",SDBEG1,1,SDAPP))=10
                   IF $PIECE(^(SDAPP,0),U,9)'="C"
                       SET SDPAT=$PIECE(^SC(SDCL,"S",SDBEG1,1,SDAPP,0),U,1)
                       if SDPAT=""
                           QUIT 
                       IF $DATA(^DPT(SDPAT,"S",SDBEG1))
                           DO CHK1
 +1        QUIT 
 +2       ;
CHK1       SET SD="SD"
           FOR SDCHK=1,2,10,12,14
               SET @(SD_SDCHK)=$PIECE(^DPT(SDPAT,"S",SDBEG1,0),U,SDCHK)
 +1        if 'SDDIVO&$PIECE(SDCL1,U,15)
               SET SDDIV=$PIECE(SDCL1,U,15)
           if 'SDDIVO&'$PIECE(SDCL1,U,15)
               SET SDDIV=$ORDER(^DG(40.8,0))
 +2        if '$DATA(^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***TOT***"))
               SET ^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***TOT***")=0
 +3        IF SDFMT=1
               Begin DoDot:1
 +4                IF (SD2="N")!(SD2="NA")
                       IF $$NOSHOW(SDPAT,SDBEG1,SDCL,$GET(^DPT(SDPAT,"S",SDBEG1,0)),SDAPP)
                           Begin DoDot:2
 +5                            DO SET
                               DO TOTAL
                               QUIT 
                           End DoDot:2
               End DoDot:1
 +6        IF SDFMT=2
               Begin DoDot:1
 +7                IF (SD2=""&('$DATA(^SC(SDCL,"S",SDBEG1,1,SDAPP,"C"))))!(SD2="N")!(SD2="NA")!(SD2="NT")
                       IF $$NOSHOW(SDPAT,SDBEG1,SDCL,$GET(^DPT(SDPAT,"S",SDBEG1,0)),SDAPP)
                           Begin DoDot:2
 +8       ;SD*572 only count No Show appts
                               DO SET
                               if SD2=""
                                   QUIT 
                               DO TOTAL
                               QUIT 
                           End DoDot:2
               End DoDot:1
 +9        IF SD2'["C"
               SET SDNM=SDNM+1
               SET ^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***SDNMS***")=SDNM
 +10       QUIT 
 +11      ;
SET        if $PIECE(SDCL1,U,15)&SDDIVO&SDV1
               SET SDDIV=$PIECE(SDCL1,U,15)
           SET ^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),SDBEG1,$PIECE(^DPT(SDPAT,0),U),+$PIECE(^(0),U,9))=SD2_U_SD10_U_SD12
 +1        QUIT 
 +2       ;
TOTAL      SET ^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***"_SD2_"***","***TOT***")=$SELECT($DATA(^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***"_SD2_"***","***TOT***")):^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***"_SD2_"***","***TOT***")+1,1:1)
 +1        SET ^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),$PIECE(SDBEG1,"."),"***"_SD2_"***","***TOT***")=$SELECT($DATA(^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),$PIECE(SDBEG1,"."),"***"_SD2_"***","***TOT***")):^("***TOT***")+1,1:1)
 +2        SET ^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***TOT***")=$SELECT($DATA(^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***TOT***")):^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***TOT***")+1,1:1)
 +3        SET ^("***TOT***")=^UTILITY($JOB,"SDNO",SDDIV,"***TOT***")+1
           SET ^("***TOT***")=$SELECT($DATA(^UTILITY($JOB,"SDNO",SDDIV,"***"_SD2_"***","***TOT***")):^UTILITY($JOB,"SDNO",SDDIV,"***"_SD2_"***","***TOT***")+1,1:1)
 +4        QUIT 
 +5       ;
RANGE      SET SDREST=$EXTRACT(SDCL,$FIND(SDCL,"*"),$LENGTH(SDCL))
           SET SDCL=$EXTRACT(SDCL,1,($FIND(SDCL,"*")-2))
           SET SDCL1=^SC(SDCL,0)
 +1        if 'SDDIVO
               SET SDDIV=$SELECT($PIECE(SDCL1,U,15):$PIECE(SDCL1,U,15),'$PIECE(SDCL1,U,15)&$DATA(^DG(43,"GL")):$PIECE(^DG(43,"GL"),U,3),1:$ORDER(^DG(40.8,0)))
 +2        SET SDR1=1
           SET SDR=$PIECE(SDCL1,U)
           DO SDTST
           KILL SDR1
 +3        SET SDREST="1"_""""_SDREST_""""_".E"
           FOR SDCXX=1:1
               SET SDR=$ORDER(^SC("B",SDR))
               if '(SDR?@SDREST)!(SDR="")
                   QUIT 
               SET SDCL=$ORDER(^SC("B",SDR,-1))
               SET SDR1=1
               DO RANGE1
               KILL SDR1
 +4        QUIT 
 +5       ;
RANGE1     if 'SDDIVO
               SET SDDIV=$SELECT($PIECE(SDCL1,U,15):$PIECE(SDCL1,U,15),'$PIECE(SDCL1,U,15)&$DATA(^DG(43,"GL")):$PIECE(^DG(43,"GL"),U,3),1:$ORDER(^DG(40.8,0)))
           DO SDTST
 +1        QUIT 
 +2       ;
NOSHOW(DFN,SDT,CIFN,PAT,DA) ;Input:  DFN=Patient IFN, SDT=Appointment D/T
 +1       ;  CIFN=Clinic IFN, PAT=Zero node of pat. appt., DA=Clinic appt. IFN
 +2       ;                        Output:  1 or 0 for noshow yes/no
 +3        NEW NSQUERY,NS
           SET NS=1
           SET NSQUERY=$$STATUS^SDAM1(DFN,SDT,CIFN,PAT,DA)
 +4        IF $PIECE(NSQUERY,";",3)["ACTION REQ"
               SET NS=0
NOSHOWQ    QUIT NS