Routine: SDAMOC

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

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

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

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

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"

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

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)

SDAMOC.m