SDAMOC ;IOFIO - BAY PINES/TEH - Statistical Report for Cancelled Appointments;4/15/92
;;5.3;Scheduling;**487,1015**;Aug 13, 1993;Build 21
;SCK - 5/18/93 MODS FOR APP CLININCS AND STOP CODES
STATS ;
K ^TMP("SDAMC"),^TMP("SDAMCD")
N POP,%,%ZIS,ZTSAVE
S SDFIN=0,SDSORT=SDSEL
S FMT=$$OPTION()
I '$$DIV^SDAMO G STATSQ
I SDSEL=6 S VAUTC=1 G STATS1
I SDSEL=5 S OPT="GETCLN" D @OPT G:SDFIN STATSQ
STATS1 ;
I '$$COMPL G ^SDAMOCC
W !!,$$LINE^SDAMOCC("Device Selection")
W !!,"This output requires 132 columns.",!!
S %ZIS="PQM" D ^%ZIS G STATSQ:POP
I $D(IO("Q")) D QUE G STATSQ
W ! D WAIT^DICD
D START^SDAMOC
STATSQ ;
D:'$D(ZTQUEUED) ^%ZISC
K SDAMDD,SDAPPT,SDASH,SDAT,SDATA,SDAT,SDCL,SDCLC,SDCLI,SDCLIN,SDCOL,SDDATE,SDDIV,SDDV,SDFLG,SDI,SDLEN,SDNXT,SDPAGE,SDPAT,SDSTAT,SDSTOP,SDTDASH
K ^TMP("SDAMS",$J),SDSEL,FMT,SDFIN,SDRUN,SCTOT,BLD,VAUTC,VAUTD,SDBEG,SDEND,VAUTNI,VAUTSTR,VAUTVB,SDSORT,DIC,DTOUT,DUOUT,DIROUT
K SDCI,SDDFN,SDASH,SDAT,SDBEG,SDCL,SDDV,SDDVNM,SDDVNM,SDEND,SDFLG,SDNXT
K SDPAGE,SDSTOP,SDTAB,SDTDASH,SDTOTT,SDY,Y
K OPT,SDFIN,SDDFN,SDNAME,X,Y
Q
;
START ;
U IO
K ^TMP("SDAMC",$J)
S SDLEN=25,SDPAGE=1,$P(SDASH,"-",IOM+1)="",$P(SDTDASH,"=",IOM+1)="",SDAMDD=$P(^DD(2.98,3,0),U,3)
D EN
I '$D(^TMP("SDAMC",$J)) D NOREP G STATSQ
I FMT=1 D BLD^SDAMOCP
I FMT'=1 D BLD^SDAMOCP1
D STATSQ Q
;
EN ; build ^TMP global
I FMT=1 D BLD1^SDAMOC
I FMT'=1 D BLD1^SDAMOC
ENQ Q
;
BLD1 ;
I VAUTD=1 S SDDIV=0 D CLINIC
S SDDV=0 F S SDDV=$O(VAUTD(SDDV)) Q:'SDDV S SDDIV=SDDV D CLINIC
Q
;
CLINIC ;all clinic or specific clinic
;
;all divisions and all clinics selected
I VAUTD=1&(VAUTC=1) D
.S SDCLIN=0 F S SDCLIN=$O(^SC(SDCLIN)) Q:'SDCLIN I $$CLINIC^SDAMU(SDCLIN) S SDCLC=$G(^SC(SDCLIN,0)) D PATIENT
;specific division and all clinics selected
I SDDIV&(VAUTC=1) D
.S SDCLIN=0 F S SDCLIN=$O(^SC(SDCLIN)) Q:'SDCLIN I $$CLINIC^SDAMU(SDCLIN) D
..S SDCLC=$G(^SC(SDCLIN,0)) I SDDIV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN) D PATIENT
;all or specific division(s) and specific clinic(s) selected
I VAUTC=0 D
.S SDCLIN=0 F S SDCLIN=$O(VAUTC(SDCLIN)) Q:'SDCLIN S SDCLC=$G(^SC(+SDCLIN,0)) D:VAUTD!(SDDIV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN)) PATIENT
Q
;
PATIENT ;loop through appointments - find status of appt.
;
S SDDATE=SDBEG-.1 N SDCTYP
F SDDATE=SDDATE:0 S SDDATE=$O(^DPT("ASDCN",SDCLIN,SDDATE)) Q:'SDDATE!(SDDATE>(SDEND_".9")) D
.S SDDFN=0 F S SDDFN=$O(^DPT("ASDCN",SDCLIN,SDDATE,SDDFN)) Q:SDDFN="" D SET
Q
;
SET ;Set in ^TMP("SDAMC",$J,Division,Clinic Name,Clinic)
;
S SDDV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN)
S SDATA=$G(^DPT(SDDFN,"S",SDDATE,0)) I 'SDATA G SETQ
S SDCTYP=$P(SDATA,U,2) I SDCTYP="" G SETQ
I SDCTYP="N"!(SDCTYP="NT")!(SDCTYP="NA")!(SDCTYP="I") G SETQ
S SDCTYP=$S(SDCTYP="C":1,SDCTYP="CA":2,SDCTYP="PC":3,SDCTYP="PCA":4,1:1)
S ^TMP("SDAMC",$J,SDDV,SDCLIN,SDCTYP)=$G(^TMP("SDAMC",$J,SDDV,SDCLIN,SDCTYP))+1
S ^TMP("SDAMCD",$J,SDDV,$P(SDATA,"^",2),SDCLIN,SDDATE,SDDFN)=SDATA_";"_SDDATE
SETQ Q
;
GETCLN S SDFIN='$$CLINIC^SDAMO Q
;
GETSC S SDFIN='$$STOP Q
;
NOREP ;report if no data in TMP global
W !!,?29,"Cancelled Clinic Report"
W !,?20,"Date Range ",$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)
D NOW^%DTC W !,?20,"Run Date: ",$E($$FDTTM^VALM1(%),1,14),?50,"Page: 1"
W !,SDASH
W !!?20,"No data found matching sort parameters"
Q
;
OPTION(CHECK) ;
S X="S^"
S X=X_"1:Summary;"
S X=X_"2:Detail"
S DIR(0)=X,DIR("A")="Select Report Format",DIR("?")="Select format for printed report",DIR("B")="Summary"
D ^DIR K DIR
Q (+Y)
QUE ;
S ZTRTN="START^SDAMOC",ZTDESC="Cancelled Clinic Report"
F X="FMT","VAUTC(","VAUTD(","SDSORT","SDSEL","SDBEG","SDEND","VAUTD","VAUTC" S ZTSAVE(X)=""
D ^%ZTLOAD W:$D(ZTSK) !,"Task #",ZTSK," Started."
D HOME^%ZIS K IO("Q"),ZTSK,ZTDESC,ZTQUEUED,ZTRTN
Q
STOP() ;
W !!,$$LINE^SDAMO("Stop Code Selection")
S DIC="^DIC(40.7,",VAUTSTR="Stop Code",VAUTVB="VAUTC",VAUTNI=2
D FIRST^VAUTOMA
I Y<0 K VAUTC
Q $D(VAUTC)>0
;
COMPL() ;
I '$$DISP^SDAMOC0 S Y=0 G COMPLQ
S DIR(0)="Y",DIR("A")="Continue",DIR("?")="Enter 'Y'es or 'N'o.",DIR("B")="YES"
D ^DIR K DIR I $D(DTOUT) S Y=0
COMPLQ Q (Y)
SDAMOC ;IOFIO - BAY PINES/TEH - Statistical Report for Cancelled Appointments;4/15/92
+1 ;;5.3;Scheduling;**487,1015**;Aug 13, 1993;Build 21
+2 ;SCK - 5/18/93 MODS FOR APP CLININCS AND STOP CODES
STATS ;
+1 KILL ^TMP("SDAMC"),^TMP("SDAMCD")
+2 NEW POP,%,%ZIS,ZTSAVE
+3 SET SDFIN=0
SET SDSORT=SDSEL
+4 SET FMT=$$OPTION()
+5 IF '$$DIV^SDAMO
GOTO STATSQ
+6 IF SDSEL=6
SET VAUTC=1
GOTO STATS1
+7 IF SDSEL=5
SET OPT="GETCLN"
DO @OPT
IF SDFIN
GOTO STATSQ
STATS1 ;
+1 IF '$$COMPL
GOTO ^SDAMOCC
+2 WRITE !!,$$LINE^SDAMOCC("Device Selection")
+3 WRITE !!,"This output requires 132 columns.",!!
+4 SET %ZIS="PQM"
DO ^%ZIS
IF POP
GOTO STATSQ
+5 IF $DATA(IO("Q"))
DO QUE
GOTO STATSQ
+6 WRITE !
DO WAIT^DICD
+7 DO START^SDAMOC
STATSQ ;
+1 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+2 KILL SDAMDD,SDAPPT,SDASH,SDAT,SDATA,SDAT,SDCL,SDCLC,SDCLI,SDCLIN,SDCOL,SDDATE,SDDIV,SDDV,SDFLG,SDI,SDLEN,SDNXT,SDPAGE,SDPAT,SDSTAT,SDSTOP,SDTDASH
+3 KILL ^TMP("SDAMS",$JOB),SDSEL,FMT,SDFIN,SDRUN,SCTOT,BLD,VAUTC,VAUTD,SDBEG,SDEND,VAUTNI,VAUTSTR,VAUTVB,SDSORT,DIC,DTOUT,DUOUT,DIROUT
+4 KILL SDCI,SDDFN,SDASH,SDAT,SDBEG,SDCL,SDDV,SDDVNM,SDDVNM,SDEND,SDFLG,SDNXT
+5 KILL SDPAGE,SDSTOP,SDTAB,SDTDASH,SDTOTT,SDY,Y
+6 KILL OPT,SDFIN,SDDFN,SDNAME,X,Y
+7 QUIT
+8 ;
START ;
+1 USE IO
+2 KILL ^TMP("SDAMC",$JOB)
+3 SET SDLEN=25
SET SDPAGE=1
SET $PIECE(SDASH,"-",IOM+1)=""
SET $PIECE(SDTDASH,"=",IOM+1)=""
SET SDAMDD=$PIECE(^DD(2.98,3,0),U,3)
+4 DO EN
+5 IF '$DATA(^TMP("SDAMC",$JOB))
DO NOREP
GOTO STATSQ
+6 IF FMT=1
DO BLD^SDAMOCP
+7 IF FMT'=1
DO BLD^SDAMOCP1
+8 DO STATSQ
QUIT
+9 ;
EN ; build ^TMP global
+1 IF FMT=1
DO BLD1^SDAMOC
+2 IF FMT'=1
DO BLD1^SDAMOC
ENQ QUIT
+1 ;
BLD1 ;
+1 IF VAUTD=1
SET SDDIV=0
DO CLINIC
+2 SET SDDV=0
FOR
SET SDDV=$ORDER(VAUTD(SDDV))
IF 'SDDV
QUIT
SET SDDIV=SDDV
DO CLINIC
+3 QUIT
+4 ;
CLINIC ;all clinic or specific clinic
+1 ;
+2 ;all divisions and all clinics selected
+3 IF VAUTD=1&(VAUTC=1)
Begin DoDot:1
+4 SET SDCLIN=0
FOR
SET SDCLIN=$ORDER(^SC(SDCLIN))
IF 'SDCLIN
QUIT
IF $$CLINIC^SDAMU(SDCLIN)
SET SDCLC=$GET(^SC(SDCLIN,0))
DO PATIENT
End DoDot:1
+5 ;specific division and all clinics selected
+6 IF SDDIV&(VAUTC=1)
Begin DoDot:1
+7 SET SDCLIN=0
FOR
SET SDCLIN=$ORDER(^SC(SDCLIN))
IF 'SDCLIN
QUIT
IF $$CLINIC^SDAMU(SDCLIN)
Begin DoDot:2
+8 SET SDCLC=$GET(^SC(SDCLIN,0))
IF SDDIV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN)
DO PATIENT
End DoDot:2
End DoDot:1
+9 ;all or specific division(s) and specific clinic(s) selected
+10 IF VAUTC=0
Begin DoDot:1
+11 SET SDCLIN=0
FOR
SET SDCLIN=$ORDER(VAUTC(SDCLIN))
IF 'SDCLIN
QUIT
SET SDCLC=$GET(^SC(+SDCLIN,0))
IF VAUTD!(SDDIV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN))
DO PATIENT
End DoDot:1
+12 QUIT
+13 ;
PATIENT ;loop through appointments - find status of appt.
+1 ;
+2 SET SDDATE=SDBEG-.1
NEW SDCTYP
+3 FOR SDDATE=SDDATE:0
SET SDDATE=$ORDER(^DPT("ASDCN",SDCLIN,SDDATE))
IF 'SDDATE!(SDDATE>(SDEND_".9"))
QUIT
Begin DoDot:1
+4 SET SDDFN=0
FOR
SET SDDFN=$ORDER(^DPT("ASDCN",SDCLIN,SDDATE,SDDFN))
IF SDDFN=""
QUIT
DO SET
End DoDot:1
+5 QUIT
+6 ;
SET ;Set in ^TMP("SDAMC",$J,Division,Clinic Name,Clinic)
+1 ;
+2 SET SDDV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN)
+3 SET SDATA=$GET(^DPT(SDDFN,"S",SDDATE,0))
IF 'SDATA
GOTO SETQ
+4 SET SDCTYP=$PIECE(SDATA,U,2)
IF SDCTYP=""
GOTO SETQ
+5 IF SDCTYP="N"!(SDCTYP="NT")!(SDCTYP="NA")!(SDCTYP="I")
GOTO SETQ
+6 SET SDCTYP=$SELECT(SDCTYP="C":1,SDCTYP="CA":2,SDCTYP="PC":3,SDCTYP="PCA":4,1:1)
+7 SET ^TMP("SDAMC",$JOB,SDDV,SDCLIN,SDCTYP)=$GET(^TMP("SDAMC",$JOB,SDDV,SDCLIN,SDCTYP))+1
+8 SET ^TMP("SDAMCD",$JOB,SDDV,$PIECE(SDATA,"^",2),SDCLIN,SDDATE,SDDFN)=SDATA_";"_SDDATE
SETQ QUIT
+1 ;
GETCLN SET SDFIN='$$CLINIC^SDAMO
QUIT
+1 ;
GETSC SET SDFIN='$$STOP
QUIT
+1 ;
NOREP ;report if no data in TMP global
+1 WRITE !!,?29,"Cancelled Clinic Report"
+2 WRITE !,?20,"Date Range ",$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDEND)
+3 DO NOW^%DTC
WRITE !,?20,"Run Date: ",$EXTRACT($$FDTTM^VALM1(%),1,14),?50,"Page: 1"
+4 WRITE !,SDASH
+5 WRITE !!?20,"No data found matching sort parameters"
+6 QUIT
+7 ;
OPTION(CHECK) ;
+1 SET X="S^"
+2 SET X=X_"1:Summary;"
+3 SET X=X_"2:Detail"
+4 SET DIR(0)=X
SET DIR("A")="Select Report Format"
SET DIR("?")="Select format for printed report"
SET DIR("B")="Summary"
+5 DO ^DIR
KILL DIR
+6 QUIT (+Y)
QUE ;
+1 SET ZTRTN="START^SDAMOC"
SET ZTDESC="Cancelled Clinic Report"
+2 FOR X="FMT","VAUTC(","VAUTD(","SDSORT","SDSEL","SDBEG","SDEND","VAUTD","VAUTC"
SET ZTSAVE(X)=""
+3 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,"Task #",ZTSK," Started."
+4 DO HOME^%ZIS
KILL IO("Q"),ZTSK,ZTDESC,ZTQUEUED,ZTRTN
+5 QUIT
STOP() ;
+1 WRITE !!,$$LINE^SDAMO("Stop Code Selection")
+2 SET DIC="^DIC(40.7,"
SET VAUTSTR="Stop Code"
SET VAUTVB="VAUTC"
SET VAUTNI=2
+3 DO FIRST^VAUTOMA
+4 IF Y<0
KILL VAUTC
+5 QUIT $DATA(VAUTC)>0
+6 ;
COMPL() ;
+1 IF '$$DISP^SDAMOC0
SET Y=0
GOTO COMPLQ
+2 SET DIR(0)="Y"
SET DIR("A")="Continue"
SET DIR("?")="Enter 'Y'es or 'N'o."
SET DIR("B")="YES"
+3 DO ^DIR
KILL DIR
IF $DATA(DTOUT)
SET Y=0
COMPLQ QUIT (Y)
