SDAMOS ;ALB/CAW - Statistical Report for Appointments;4/15/92
;;5.3;Scheduling;**11,46**;Aug 13, 1993
;SCK - 5/18/93 MODS FOR APP CLININCS AND STOP CODES
STATS ;
N OPT,SDFIN
K ^TMP("SDAMS",$J)
S SDFIN=0,SDSORT=SDSEL
I '$$FORMAT G STATSQ
I '$$DIV^SDAMO G STATSQ
I SDSEL=6 S VAUTC=1 G STATS1
I SDSEL=5 S OPT=$S(FMT=1:"GETCLN",1:"GETSC") D @OPT G:SDFIN STATSQ
STATS1 ;
I '$$COMPL G ^SDAMO
W !!,$$LINE^SDAMO("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^SDAMOS
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
Q
;
START ;
U IO
K ^TMP("SDAMS",$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("SDAMS",$J)) D NOREP^SDAMOS1 G STATSQ
I FMT=1 D BLD^SDAMOSP
I FMT'=1 D BLD^SDAMOS1
D STATSQ Q
;
EN ; build ^TMP global
I FMT=1 D BLD1^SDAMOS
I FMT'=1 D STOPC^SDAMOS0
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
F SDDATE=SDDATE:0 S SDDATE=$O(^SC(SDCLIN,"S",SDDATE)) Q:'SDDATE!(SDDATE>(SDEND_".9")) D
.S SDAPPT=0 F S SDAPPT=$O(^SC(SDCLIN,"S",SDDATE,1,SDAPPT)) Q:'SDAPPT D SET
Q
;
SET ;Set in ^TMP("SDAMS",$J,Division,Clinic Name,Clinic IFN,Appt Status)
;
S SDDV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN),SDPAT=+$G(^SC(SDCLIN,"S",SDDATE,1,SDAPPT,0))
S SDATA=$G(^DPT(SDPAT,"S",SDDATE,0)) I 'SDATA G SETQ
G:'$$VALID^SDAM2(SDPAT,SDCLIN,SDDATE,SDAPPT) SETQ
S SDSTAT=$$STATUS^SDAM1(SDPAT,SDDATE,SDCLIN,SDATA,SDAPPT)
S ^(+SDSTAT)=$G(^TMP("SDAMS",$J,SDDV,$P(^SC(SDCLIN,0),U),SDCLIN,+SDSTAT))+1
S SDCL("SDAMS",$J,SDDV,+SDSTAT)=$G(SDCL("SDAMS",$J,SDDV,+SDSTAT))+1
S SDAT("SDAMS",$J,+SDSTAT)=$G(SDAT("SDAMS",$J,+SDSTAT))+1
I +SDSTAT["4^5^6^7",$P(SDSTAT,U,4)'="" S SDCI(SDCLIN,+SDSTAT)=$G(SDCI(SDCLIN,+SDSTAT))+1
SETQ Q
;
GETCLN S SDFIN='$$CLINIC^SDAMO Q
;
GETSC S SDFIN='$$STOP Q
;
FORMAT() ;
N Y S Y=0
W !!,$$LINE^SDAMO("Report Format")
S FMT=$$OPTION(0)
Q (Y)
;
OPTION(CHECK) ;
S X="S^"
S X=X_"1:Appointment Clinic;"
S X=X_"2:Stop Code"
S DIR(0)=X,DIR("A")="Select Report Format",DIR("?")="Select format for printed report",DIR("B")="Appointment Clinic"
D ^DIR K DIR
Q (+Y)
QUE ;
S ZTRTN="START^SDAMOS",ZTDESC="Appointment Management 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")
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^SDAMOS0 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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMOS 3962 printed Apr 09, 2024@21:58:13 Page 2
SDAMOS ;ALB/CAW - Statistical Report for Appointments;4/15/92
+1 ;;5.3;Scheduling;**11,46**;Aug 13, 1993
+2 ;SCK - 5/18/93 MODS FOR APP CLININCS AND STOP CODES
STATS ;
+1 NEW OPT,SDFIN
+2 KILL ^TMP("SDAMS",$JOB)
+3 SET SDFIN=0
SET SDSORT=SDSEL
+4 IF '$$FORMAT
GOTO STATSQ
+5 IF '$$DIV^SDAMO
GOTO STATSQ
+6 IF SDSEL=6
SET VAUTC=1
GOTO STATS1
+7 IF SDSEL=5
SET OPT=$SELECT(FMT=1:"GETCLN",1:"GETSC")
DO @OPT
if SDFIN
GOTO STATSQ
STATS1 ;
+1 IF '$$COMPL
GOTO ^SDAMO
+2 WRITE !!,$$LINE^SDAMO("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^SDAMOS
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 QUIT
+5 ;
START ;
+1 USE IO
+2 KILL ^TMP("SDAMS",$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("SDAMS",$JOB))
DO NOREP^SDAMOS1
GOTO STATSQ
+6 IF FMT=1
DO BLD^SDAMOSP
+7 IF FMT'=1
DO BLD^SDAMOS1
+8 DO STATSQ
QUIT
+9 ;
EN ; build ^TMP global
+1 IF FMT=1
DO BLD1^SDAMOS
+2 IF FMT'=1
DO STOPC^SDAMOS0
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
+3 FOR SDDATE=SDDATE:0
SET SDDATE=$ORDER(^SC(SDCLIN,"S",SDDATE))
if 'SDDATE!(SDDATE>(SDEND_".9"))
QUIT
Begin DoDot:1
+4 SET SDAPPT=0
FOR
SET SDAPPT=$ORDER(^SC(SDCLIN,"S",SDDATE,1,SDAPPT))
if 'SDAPPT
QUIT
DO SET
End DoDot:1
+5 QUIT
+6 ;
SET ;Set in ^TMP("SDAMS",$J,Division,Clinic Name,Clinic IFN,Appt Status)
+1 ;
+2 SET SDDV=$$DIV^SDAMU(.SDCLIN,.VAUTD,.SDNAME,.SDLEN)
SET SDPAT=+$GET(^SC(SDCLIN,"S",SDDATE,1,SDAPPT,0))
+3 SET SDATA=$GET(^DPT(SDPAT,"S",SDDATE,0))
IF 'SDATA
GOTO SETQ
+4 if '$$VALID^SDAM2(SDPAT,SDCLIN,SDDATE,SDAPPT)
GOTO SETQ
+5 SET SDSTAT=$$STATUS^SDAM1(SDPAT,SDDATE,SDCLIN,SDATA,SDAPPT)
+6 SET ^(+SDSTAT)=$GET(^TMP("SDAMS",$JOB,SDDV,$PIECE(^SC(SDCLIN,0),U),SDCLIN,+SDSTAT))+1
+7 SET SDCL("SDAMS",$JOB,SDDV,+SDSTAT)=$GET(SDCL("SDAMS",$JOB,SDDV,+SDSTAT))+1
+8 SET SDAT("SDAMS",$JOB,+SDSTAT)=$GET(SDAT("SDAMS",$JOB,+SDSTAT))+1
+9 IF +SDSTAT["4^5^6^7"
IF $PIECE(SDSTAT,U,4)'=""
SET SDCI(SDCLIN,+SDSTAT)=$GET(SDCI(SDCLIN,+SDSTAT))+1
SETQ QUIT
+1 ;
GETCLN SET SDFIN='$$CLINIC^SDAMO
QUIT
+1 ;
GETSC SET SDFIN='$$STOP
QUIT
+1 ;
FORMAT() ;
+1 NEW Y
SET Y=0
+2 WRITE !!,$$LINE^SDAMO("Report Format")
+3 SET FMT=$$OPTION(0)
+4 QUIT (Y)
+5 ;
OPTION(CHECK) ;
+1 SET X="S^"
+2 SET X=X_"1:Appointment Clinic;"
+3 SET X=X_"2:Stop Code"
+4 SET DIR(0)=X
SET DIR("A")="Select Report Format"
SET DIR("?")="Select format for printed report"
SET DIR("B")="Appointment Clinic"
+5 DO ^DIR
KILL DIR
+6 QUIT (+Y)
QUE ;
+1 SET ZTRTN="START^SDAMOS"
SET ZTDESC="Appointment Management 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")
+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^SDAMOS0
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)
