SDNOS0 ;ALB/LDB - NO SHOW REPORT ; 07 May 99 10:21 AM
;;5.3;PIMS;**20,194,410,517,523,1015,1016**;JUN 30, 2012;Build 20
;IHS/ANMC/LJF 11/03/2000 changed SSN to chart #
; and saved DFN in ^utility
; added call to list template
;
I $E(IOST,1,2)="C-" D ^BSDNOS Q ;IHS/ANMC/LJF 11/03/2000
IHS ;EP; entry point for list template ;IHS/ANMC/LJF 11/03/2000
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
S SDFMT=1 ;ihs/cmi/maw 02/27/2011 patch 1015
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 ;IHS/ANMC/LJF 11/03/2000
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),+$$HRCN^BDGF2(SDPAT,+$G(DUZ(2))))=SD2_U_SD10_U_SD12_U_SDPAT ;IHS/ANMC/LJF 11/03/2000
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
SDNOS0 ;ALB/LDB - NO SHOW REPORT ; 07 May 99 10:21 AM
+1 ;;5.3;PIMS;**20,194,410,517,523,1015,1016**;JUN 30, 2012;Build 20
+2 ;IHS/ANMC/LJF 11/03/2000 changed SSN to chart #
+3 ; and saved DFN in ^utility
+4 ; added call to list template
+5 ;
+6 ;IHS/ANMC/LJF 11/03/2000
IF $EXTRACT(IOST,1,2)="C-"
DO ^BSDNOS
QUIT
IHS ;EP; entry point for list template ;IHS/ANMC/LJF 11/03/2000
+1 DO END1^SDNOS
+2 SET (SDV1,SDIN,SDNM,SDNM1)=0
SET SDDIVO=SDDIV
+3 IF $DATA(^DG(43,1,"GL"))
IF $PIECE(^("GL"),U,2)
SET SDV1=1
+4 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
+5 IF SDDIV="A"
DO DIVRPT
+6 IF SDCL(1)="ALL"
SET SDCL=0
DO SDCL
+7 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
+8 SET (P1,SDTOT,SDTOT1)=0
SET DGTCH="NO-SHOW REPORT^CLINIC^PAGE#"
SET (SDEND,SDHD)=0
+9 DO ^SDNOS1
+10 QUIT
+11 ;
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 ;ihs/cmi/maw 02/27/2011 patch 1015
SET SDFMT=1
+4 IF SDFMT=1
Begin DoDot:1
+5 IF (SD2="N")!(SD2="NA")
IF $$NOSHOW(SDPAT,SDBEG1,SDCL,$GET(^DPT(SDPAT,"S",SDBEG1,0)),SDAPP)
Begin DoDot:2
+6 DO SET
DO TOTAL
QUIT
End DoDot:2
End DoDot:1
+7 IF SDFMT=2
Begin DoDot:1
+8 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
+9 ;SD*572 only count No Show appts
DO SET
IF SD2=""
QUIT
DO TOTAL
QUIT
End DoDot:2
End DoDot:1
+10 IF SD2'["C"
SET SDNM=SDNM+1
SET ^UTILITY($JOB,"SDNO",SDDIV,$PIECE(SDCL1,U),"***SDNMS***")=SDNM
+11 QUIT
+12 ;
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 ;IHS/ANMC/LJF 11/03/2000
+1 ;IHS/ANMC/LJF 11/03/2000
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),+$$HRCN^BDGF2(SDPAT,+$GET(DUZ(2))))=SD2_U_SD10_U_SD12_U_SDPAT
+2 QUIT
+3 ;
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
