SDMHAD ;MAF/ALB - MENTAL HEALTH AD HOC NO SHOW REPORT ; JULY 14, 2010
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
;
EN ;entry point for the manual generation of the No Show Report
N SDBEG,SDEND,VAUTD,Y,SDUP,SDXFLG,SDTL,SDALL,SDDAT,Y,X,SDDAT,VADAT,ZTRTN,ZTSAVE,VADATE,%ZIS,SDALL
I '$$RANGE G QUIT
I '$$DIV G QUIT
SORT R !,"Sort report by (M)ental Health Clinic Quick List,(C)linic or (S)top Code: M//",X:DTIME G:X["^"!('$T) QUIT S X=$S(X="":"M",1:$E(X,1))
I "CMScms"'[X W @IOF D G SORT
.W "Enter: 'M' to run the report using the face-to-face Mental Health clinics",!,?7,"defined in the 'VA-MH NO SHOW APPT CLINICS LL' Reminder Location List",!,?7,"- with no additional prompts to refine the list of Mental Health clinics."
. W !,"Enter: 'C' to run the report by clinics which will then prompt",!,?7,"to refine the list of clinics to use."
. W !,"Enter: 'S' to run the report by stop codes which will then prompt",!,?7,"to refine the list of stop codes to use.",!
.Q
;I "CMScms"'[X W !,?10,"Enter: ","'C' for clinic",!,?18,"'M' for Mental Health Clinics Quick List",!,?18,"'S' for stop codes" G SORT
S SDTL=$S($G(X)="C":"CLIN",$G(X)="c":"CLIN",$G(X)="S":"STOP",$G(X)="s":"STOP",1:"MEN")
I SDTL="MEN" S Y=0 S SDALL="M" D LIST Q:Y=1
D @(SDTL) G:Y=-1 QUIT
FUTNUM N SDFUTNUM
R !,"Select Number of days to List Future Appointments: 30//",X:DTIME G:X["^"!('$T) QUIT S X=$S(X="":"30",1:X) S SDFUTNUM=X
I X'?.N!(X=0)!(X>90) W !!,?10,"Enter a number of days from 1 to 90. Future scheduled appointments",!,?10,"for the patients will list that number of days in the future",!,?10,"on the No Show report.",! G FUTNUM
;S SDFUTNUM=X
W !!,*7,"This output requires 80 column output",!
D NOW^%DTC S Y=$E(%,1,12) S SDDAT=$$FMTE^XLFDT(Y,"5")
S IOM=80 S %ZIS="QM",%ZIS("A")="Select Device: ",%ZIS("B")="" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTRTN="START^SDMHAD",ZTSAVE("SD*")="",ZTSAVE("VA*")="" D ^%ZTLOAD K IO("Q"),ZTSK Q
;
START ;
I $E(IOST)="C" D WAIT^DICD I $D(SDXFLG) D
.W !!,?10,"This report option generates a mail message containing the"
.W !,?10,"High Risk Mental Health No Show Nightly Report which is sent"
.W !,?10,"only to individuals in the SD MH NO SHOW NOTIFICATION mailgroup.",!
N SDDIV,SDPAG,SDCL,SDSC,SDRLL,SDPAG,NAMSPC,NAMSPC1,SDSTOP,VAUTRR,SDLINE,Y,TOTAL,SDPAT
N X S X="DGPFAPIH" X ^%ZOSF("TEST") S X="" I '$T D Q
.I '$D(SDXFLG) W !!,"Patch DG*5.3*836 needs to be installed - ICR 4903.",!,"Routines required to run report. Aborting!",! Q
.N SDX S SDX=""
.S SDX=$$SETSTR^SDMHNS1("Patch DG*5.3*836 needs to be installed - ICR 4903.",X,1,80) D SET1^SDMHNS1(SDX)
.S SDX="" S SDX=$$SETSTR^SDMHNS1("Routines required to run report. Report Aborted!",X,1,80) D SET1^SDMHNS1(SDX)
.S SDX=""
S Y=0 D LIST Q:Y=1
S NAMSPC=$$NAMSPC
S NAMSPC1=$$NAMSPC1
K ^TMP(NAMSPC),^TMP(NAMSPC1)
S (SDPAG,SDCL,SDSC,SDRLL)=0
I $D(SDXFLG),SDXFLG=1 S VAUTCL=1
I $D(SDXFLG) D PXRMD
I $D(SDALL) I SDALL="M" D PXRMD
I VAUTD=1 D
.S SDDIV=0 F SDDIV=0:0 S SDDIV=$O(^DG(40.8,SDDIV)) Q:'SDDIV I $D(^DG(40.8,SDDIV,0)) S VAUTD(SDDIV)=$P(^DG(40.8,SDDIV,0),"^",1)
I SDTL'="MEN" F SDCL=0:0 S SDCL=$O(^SC(SDCL)) Q:'SDCL I $D(^SC(SDCL,0)),$P($G(^SC(SDCL,0)),"^",3)="C" D
.S SDSC=$P($G(^SC(SDCL,0)),"^",7),SDDIV=$S('$P($G(^SC(SDCL,0)),"^",15):"NOT SPECIFIED",1:$P($G(^SC(SDCL,0)),"^",15)) I SDSC D CHK ;S ^TMP("SDCLST",$J,SDCL,SDSC)=$P(^SC(SDCL,0),"^",1)
I SDTL="MEN" S SDRLL=$O(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL",0)) D
.F SDDIV=0:0 S SDDIV=$O(VAUTRR(SDDIV)) Q:'SDDIV F SDSC=0:0 S SDSC=$O(VAUTRR(SDDIV,SDSC)) Q:'SDSC F SDCL=0:0 S SDCL=$O(VAUTRR(SDDIV,SDSC,SDCL)) Q:'SDCL I SDCL D CHK
S SDLINE=$S($D(^TMP(NAMSPC,$J)):"PROCESS",1:"END")
D @SDLINE
G QUIT
;
;
PROCESS ;find patients in date range that had a no show appt for a MH clinic.
N SDIV,SDC,SDR,SDS,SDHFL,SDUP,SDMHFLG
S (SDIV,SDC,SDR,SDS,SDUP)=0
S SDMHFLG=$$GET^XPAR("PKG.REGISTRATION","DGPF SUICIDE FLAG",1,"E")
S SDMHFLG=$$GETFLAG^DGPFAPIU(SDMHFLG)
F SDIV=0:0 S SDIV=$O(^TMP(NAMSPC,$J,SDIV)) Q:SDIV=""!(SDUP) F SDC=SDC:0 S SDC=$O(^TMP(NAMSPC,$J,SDIV,SDC)) Q:SDC=""!(SDUP) F SDS=SDS:0 S SDS=$O(^TMP(NAMSPC,$J,SDIV,SDC,SDS)) Q:SDS=""!(SDUP) D
.I SDTL="MEN" S SDR=$P($G(^TMP(NAMSPC,$J,SDIV,SDC,SDS)),"^",4)
.N SDDT,SDNUM,SDNUM1,DFN,SDSTAT,ACT,SDRR
.S (SDDT,SDNUM,SDNUM1,DFN,SDSTAT)=0
.F SDDT=SDBEG:0 S SDDT=$O(^SC(SDC,"S",SDDT)) Q:'SDDT!(SDDT>SDEND)!(SDUP) F SDNUM=0:0 S SDNUM=$O(^SC(SDC,"S",SDDT,SDNUM)) Q:'SDNUM!(SDUP) F SDNUM1=0:0 S SDNUM1=$O(^SC(SDC,"S",SDDT,SDNUM,SDNUM1)) Q:'SDNUM1!(SDUP) D
..Q:'$D(^SC(SDC,"S",SDDT,SDNUM,SDNUM1,0))
..S DFN=$P($G(^SC(SDC,"S",SDDT,SDNUM,SDNUM1,0)),"^",1) Q:$D(^SC(SDC,"S",SDDT,SDNUM,SDNUM1,"C")) I $D(^DPT(DFN,0)),$D(^DPT(DFN,"S",SDDT)) S SDSTAT=$P($G(^DPT(DFN,"S",SDDT,0)),"^",2) I $$GETINF^DGPFAPIH(DFN,SDMHFLG,SDDT,SDDT,"ACT") D Q:SDUP
...N PATNM,SDCLNM,SDDIVNM,SDSCNM,SDZERO
...;S SDXZERO=^DPT(DFN,"S",SDDT,0)
...;S SDDA=$$FIND^SDAM2(DFN,SDDT,SDC)
...;S SDSTAT=$$STATUS^SDAM1(DFN,SDDT,SDNUM,SDXZERO,SDDA)
... ;Q:SDSTAT=""
... S SDSTAT=$S(SDSTAT="N":"NS",SDSTAT="NT":"NAT",SDSTAT="NA":"NSA",SDSTAT="":"NAT",1:SDSTAT)
...;I '$D(SDXFLG) I SDSTAT="" S SDSTAT="NT" I "N^NA"'[SDSTAT Q ;!(SDSTAT'="NA")
...I SDSTAT'["N" Q
...S SDDIVNM=$S($P(^DG(40.8,SDIV,0),"^",1)="NOT SPECIFIED":"NOT SPECIFIED",1:$P(^DG(40.8,SDIV,0),"^",1))
...S SDCLNM=$S($P($G(^SC(SDC,0)),"^",1)="NOT SPECIFIED":"NOT SPECIFIED",1:$P(^SC(SDC,0),"^",1))
...S SDSCNM=$S($P($G(^DIC(40.7,SDS,0)),"^",1)="NOT SPECIFIED":"NOT SPECIFIED",1:$P(^DIC(40.7,SDS,0),"^",1))
...S PATNM=$S($P($G(^DPT(DFN,0)),"^",1)="NOT SPECIFIED":"NOT SPECIFIED",1:$P(^DPT(DFN,0),"^",1))
...I SDTL="CLIN" S ^TMP(NAMSPC1,$J,SDDIVNM,SDCLNM,PATNM,SDS,SDDT)=DFN_"^"_SDDT_"^"_SDSTAT_"^"_$$PID(DFN)_"^"_SDC_"^"_SDS ;D TOTAL(SDDIVNM,SDCLNM)
...I SDTL="STOP" S ^TMP(NAMSPC1,$J,SDDIVNM,SDSCNM,PATNM,SDCLNM,SDDT)=DFN_"^"_SDDT_"^"_SDSTAT_"^"_$$PID(DFN)_"^"_SDC_"^"_SDS
...I SDTL="MEN" S SDRR=$P(^PXRMD(810.9,SDR,0),"^",1) S ^TMP(NAMSPC1,$J,SDDIVNM,SDRR,SDCLNM,PATNM,SDDT)=DFN_"^"_SDDT_"^"_SDSTAT_"^"_$$PID(DFN)_"^"_SDC_"^"_SDS
...D TOTAL(SDDIVNM,SDCLNM)
BGJ I $D(SDXFLG) D Q
.I '$D(^TMP(NAMSPC1,$J)) D HEAD^SDMHNS
.D ^SDMHNS1 Q
I '$D(^TMP(NAMSPC1,$J)) G END
D ^SDMHAD1
Q
CHK ;Check to see if Division/Clinic/Stop have been selected & if Clinic and Stop code are a valid mental health pair.
N SDFLG,SDCLNM,SDDIVNM,SDSCNM
S SDFLG=0
I $D(VAUTD) D Q:SDFLG
. I SDDIV="NOT SPECIFIED" S SDFLG=1 Q
. I 'VAUTD,'$D(VAUTD(SDDIV)) S SDFLG=1 Q
I $D(VAUTCL) D Q:SDFLG
. I SDCL="NOT SPECIFIED" S SDFLG=1 Q
. I 'VAUTCL,'$D(VAUTCL(SDCL)) S SDFLG=1 Q
I $D(VAUTSC) D Q:SDFLG
. I SDSC="NOT SPECIFIED" S SDFLG=1 Q
. I 'VAUTSC,'$D(VAUTSC(SDSC)) S SDFLG=1 Q
Q:'$D(^DG(40.8,SDDIV,0))
S SDDIVNM=$S($P($G(^DG(40.8,SDDIV,0)),"^",1)="":"NOT SPECIFIED",1:$P(^DG(40.8,SDDIV,0),"^",1))
Q:'$D(^SC(SDCL,0))
S SDCLNM=$S($P($G(^SC(SDCL,0)),"^",1)="":"NOT SPECIFIED",1:$P(^SC(SDCL,0),"^",1))
Q:'$D(^DIC(40.7,SDSC,0))
S SDSCNM=$S($P($G(^DIC(40.7,SDSC,0)),"^",1)="":"NOT SPECIFIED",1:$P(^DIC(40.7,SDSC,0),"^",1))
S ^TMP(NAMSPC,$J,SDDIV,SDCL,SDSC)=SDDIVNM_"^"_SDCLNM_"^"_SDSCNM_"^"_$S(SDRLL="NOT SPECIFIED":"NOT SPECIFIED",1:SDRLL)
Q
;
HEAD ;Heading for the report
W @IOF
W "HIGH RISK MENTAL HEALTH NO SHOW ADHOC REPORT BY",?70,"PAGE " S SDPAG=SDPAG+1 W SDPAG,!
W $S(SDTL="MEN":"MH CLINICS",SDTL="STOP":"STOP CODES",1:"CLINICS")_" for Appointments "_$$FMTE^XLFDT(SDBEG,"2")_"-"_$$FMTE^XLFDT($P(SDEND,".",1),"2"),?56,"Run: "_SDDAT
I $D(SDTOTPG) W !!,"Totals Page"
I '$D(SDTOTPG) W !!,"PATIENT",?23,"PT ID",?33,"APPT D/T",?53,"CLINIC",?73,"STATUS"
W !,$$LINE(""),!
;W "*STATUS: NS = No Show NSA = No Show Auto Rebook NAT = No Action Taken",!!
HEAD1 I $D(^TMP(NAMSPC1,$J)),'$D(SDTOTPG) D
. N SDHEAD2
B .I SDTL'="STOP" S SDHEAD2="DIVISION/CLINIC/STOP: "_$E(SDXDIV,1,24)_"/"_$E(SDXCLIN,1,26)_"/"_$E(SDXSTOP,1,4)
.;I SDTL="CLIN" S SDHEAD2="DIVISION/CLINC/STOP CODE: "_SDXDIV_"/"_SDXCLIN_"/"_SDXSTOP
.I SDTL="STOP" S SDHEAD2="DIVISION/STOP/CLINIC: "_$E(SDXDIV,1,24)_"/"_$E(SDXSTOPN,1,4)_"/"_$E(SDXCLIN,1,26)
.;I SDTL="STOP" S SDHEAD2="DIVISION/STOP/CLINIC: "_$E(SDXDIV,1,24)_"/"_$E($P($G(^DIC(40.7,$O(^DIC(40.7,"B",SDXSTOP,0)),0)),"^",2),1,4)_"/"_$E(SDXCLIN,1,26)
.;S SDHEAD2=$S(SDTL="MEN":"DIVISION/MH CLIN LIST/CLINIC: "_SDXDIV_"/"_SDXREM,SDTL="CLIN":"DIVISION/CLINIC: "_SDXDIV_"/"_SDXCLIN,1:"DIVISION/STOP CODE: "_SDXDIV_"/"_SDXSTOP_"-"_$P($G(^DIC(40.7,$O(^DIC(40.7,"B",SDXSTOP,0)),0)),"^",2)) W !
.W SDHEAD2,!
Q
;
;
RANGE() ;Select Start and End date for report
W !!,$$LINE(" High Risk Mental Health NO SHOW Adhoc Report")
Q $$RANGE^SDAMQ(.SDBEG,.SDEND)
;
DIV() ;Division selection for multidivisional facility
D ASK2^SDDIV I Y<0 K VAUTD
Q $D(VAUTD)>0
;
LIST N X I '$D(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL")) D Q
.I '$D(SDXFLG) W !!!,"Reminder location List file is not current.",!,"Missing reminder location list 'VA-MH NO SHOW APPT CLINICS LL' in file 810.9.",!,"Report Aborting!",! S Y=1 Q
.N SDX S SDX="",X=""
.S SDX=$$SETSTR^SDMHNS1("Reminder location List file is not current.",X,1,80) D SET1^SDMHNS1(SDX)
.S SDX="",X="" S SDX=$$SETSTR^SDMHNS1("Missing reminder location list 'VA-MH NO SHOW APPT CLINICS LL' in file 810.9.",X,1,80) D SET1^SDMHNS1(SDX)
.S SDX="",X="" S SDX=$$SETSTR^SDMHNS1("Report Aborted!",X,1,80) D SET1^SDMHNS1(SDX)
.S SDX=""
.S Y=1
LINE(STR) ; Print display prompts
N X
S:STR]"" STR=" "_STR_" "
S $P(X,"*",(IOM/2)-($L(STR)/2))=""
Q X_STR_X
;
LINE1(STR) ; Print display prompts
N X
S:STR]"" STR=" "_STR_" "
S $P(X," ",(IOM/2)-($L(STR)/2))=""
Q X_STR_X
;
;
TOTAL(DIV,CLST) ;INITIALIZE total(DIV,CLIN/STOP)
I '$D(TOTAL(DIV,CLST)) D
.N SDCNTT S SDCNTT=0
.S TOTAL(DIV,CLST)="0^0^0^0^0"
I $D(TOTAL(DIV,CLST)) D
.S $P(TOTAL(DIV,CLST),"^",1)=$P($G(TOTAL(DIV,CLST)),"^",1)+1
.N X S X=$S(SDSTAT="NS":2,SDSTAT="NSA":3,1:4) S $P(TOTAL(DIV,CLST),"^",X)=$P(TOTAL(DIV,CLST),"^",X)+1
.I '$D(SDPAT(DIV,CLST,DFN)) S SDPAT(DIV,CLST,DFN)="",$P(TOTAL(DIV,CLST),"^",5)=$P(TOTAL(DIV,CLST),"^",5)+1
Q
;
;
CLIN ;select clinics
W !!,"Clinic Selection:",!,?20,"A All clinics",!,?20,"M Mental Health clinics only",!
CL1 R !,"Select: (A)ll clinics A//",X:DTIME S:X["^"!('$T) Y=-1 Q:Y=-1 S X=$S(X="":"A",1:$E(X)) I "AMam"'[X W !,?6,"Enter : 'A' for All clinics",!,?14,"'M' for Mental Health clinics only" G CL1
S SDALL=X
N DIC,K,VAUTVB,VAUTSTR,VAUTNI
S VAUTVB="VAUTCL",DIC="^SC("
I SDALL="M" S DIC("S")="N X,K S X=$O(^PXRMD(810.9,""B"",""VA-MH NO SHOW APPT CLINICS LL"",0)) I $D(^SC(+Y,0)) S K=$P(^SC(+Y,0),""^"",7) I $D(^PXRMD(810.9,X,40.7,""B"",+K))"
S VAUTSTR="Clinic",VAUTNI=2 D FIRST^VAUTOMA S:Y=-1 SDFL=1 Q:$D(SDFL)
Q
;
STOP N SDFL,DIC,K,VAUTVB,VAUTSTR,VAUTNI
W !!,"Stop Code Selection:",!,?20,"A All Stop Codes",!,?20,"M Mental Health Stop Codes only",!
ST1 R !,"Select: (A)ll Stop Codes A//",X:DTIME S:X["^"!('$T) Y=-1 Q:Y=-1 S X=$S(X="":"A",1:$E(X)) I "AMam"'[X W !,?6,"Enter: 'A' for All Stop Codes",!,?14,"'M' for Mental Health Stop Codes only" G ST1
S SDALL=X
S VAUTVB="VAUTSC",DIC="^DIC(40.7,"
I SDALL="M" S DIC("S")="N X S X=$O(^PXRMD(810.9,""B"",""VA-MH NO SHOW APPT CLINICS LL"",0)) I $D(^PXRMD(810.9,X,40.7,""B"",+Y))"
S VAUTSTR="Stop codes",VAUTNI=2 D FIRST^VAUTOMA
Q
STOP1 N SDFL,DIC,K,VAUTVB,VAUTSTR,VAUTNI
S VAUTVB="VAUTSC",DIC="^DIC(40.7,",DIC("S")="S SDFL=0 D MEN1^SDMHAD I SDFL",VAUTSTR="Stop codes",VAUTNI=2 D FIRST^VAUTOMA
Q
;
MEN S VAUTR=0
MEN1 N X S X=$O(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL",0)) S VAUTR(X)=$P($G(^PXRMD(810.9,X,0)),"^",1)
I SDTL="STOP" D
. I $D(^PXRMD(810.9,X,40.7,"B",+Y)) S SDFL=1
. Q
Q
;
PID(DFN) ; Return PID
; INPUT - DFN
; OUTPUT - PID or 'UNKNOWN'
N VA
D PID^VADPT6
Q $S(VA("BID")]"":VA("BID"),1:"UNKNOWN")
;
NAMSPC() ; API returns the name space for this patch
Q "SDNSHOW"
NAMSPC1() ; API returns the name space for this patch
Q "SDNS"
PXRMD ;Set up Reminder Location List valid Stop Codes for No Show Report
N SDX,SDY,SDI,SDSFL,SDCFL
S SDY=0
S SDX=$O(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL",0)) Q:SDX']"" F S SDY=$O(^PXRMD(810.9,SDX,40.7,"B",SDY)) Q:SDY']"" D
.S SDSTOP(+SDY)=""
.I SDTL="MEN" N SDI S SDI=0 F S SDI=$O(^SC("AST",+SDY,SDI)) Q:SDI']"" S VAUTRR(+$P($G(^SC(+SDI,0)),"^",15),+SDY,+SDI)=""
.I $D(VAUTSC),$G(VAUTSC)=1 S VAUTSC(+SDY)=$P($G(^DIC(40.7,+SDY,0)),"^",1) S SDSFL=1
.I $D(VAUTCL),$G(VAUTCL)=1 N SDI S SDI=0 F S SDI=$O(^SC("AST",+SDY,SDI)) Q:SDI']"" D
..S VAUTCL(+SDI)=$P($G(^SC(+SDI,0)),"^",1) S SDCFL=1
I $D(SDSFL) S VAUTSC=0
I $D(SDCFL) S VAUTCL=0
Q
END ;NO RECORDS
D HEAD
W !!,$$LINE1(">>>>>> NO RECORDS FOUND <<<<<<")
QUIT K %DT,DIR,SDTBEG,SDTEND,SDDIV,VAUTD,VAUTCL,VAUTR,VAUTSC,VADAT,VADATE,POP,X,Y
K ^TMP("SDNSHOW",$J),^TMP("SDNS",$J)
D CLOSE^DGUTQ Q
SDMHAD ;MAF/ALB - MENTAL HEALTH AD HOC NO SHOW REPORT ; JULY 14, 2010
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ;
EN ;entry point for the manual generation of the No Show Report
+1 NEW SDBEG,SDEND,VAUTD,Y,SDUP,SDXFLG,SDTL,SDALL,SDDAT,Y,X,SDDAT,VADAT,ZTRTN,ZTSAVE,VADATE,%ZIS,SDALL
+2 IF '$$RANGE
GOTO QUIT
+3 IF '$$DIV
GOTO QUIT
SORT READ !,"Sort report by (M)ental Health Clinic Quick List,(C)linic or (S)top Code: M//",X:DTIME
IF X["^"!('$TEST)
GOTO QUIT
SET X=$SELECT(X="":"M",1:$EXTRACT(X,1))
+1 IF "CMScms"'[X
WRITE @IOF
Begin DoDot:1
+2 WRITE "Enter: 'M' to run the report using the face-to-face Mental Health clinics",!,?7,"defined in the 'VA-MH NO SHOW APPT CLINICS LL' Reminder Location List",!,?7,"- with no additional prompts to refine the list of Mental Health clinic
s."
+3 WRITE !,"Enter: 'C' to run the report by clinics which will then prompt",!,?7,"to refine the list of clinics to use."
+4 WRITE !,"Enter: 'S' to run the report by stop codes which will then prompt",!,?7,"to refine the list of stop codes to use.",!
+5 QUIT
End DoDot:1
GOTO SORT
+6 ;I "CMScms"'[X W !,?10,"Enter: ","'C' for clinic",!,?18,"'M' for Mental Health Clinics Quick List",!,?18,"'S' for stop codes" G SORT
+7 SET SDTL=$SELECT($GET(X)="C":"CLIN",$GET(X)="c":"CLIN",$GET(X)="S":"STOP",$GET(X)="s":"STOP",1:"MEN")
+8 IF SDTL="MEN"
SET Y=0
SET SDALL="M"
DO LIST
IF Y=1
QUIT
+9 DO @(SDTL)
IF Y=-1
GOTO QUIT
FUTNUM NEW SDFUTNUM
+1 READ !,"Select Number of days to List Future Appointments: 30//",X:DTIME
IF X["^"!('$TEST)
GOTO QUIT
SET X=$SELECT(X="":"30",1:X)
SET SDFUTNUM=X
+2 IF X'?.N!(X=0)!(X>90)
WRITE !!,?10,"Enter a number of days from 1 to 90. Future scheduled appointments",!,?10,"for the patients will list that number of days in the future",!,?10,"on the No Show report.",!
GOTO FUTNUM
+3 ;S SDFUTNUM=X
+4 WRITE !!,*7,"This output requires 80 column output",!
+5 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
SET SDDAT=$$FMTE^XLFDT(Y,"5")
+6 SET IOM=80
SET %ZIS="QM"
SET %ZIS("A")="Select Device: "
SET %ZIS("B")=""
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTRTN="START^SDMHAD"
SET ZTSAVE("SD*")=""
SET ZTSAVE("VA*")=""
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
QUIT
+7 ;
START ;
+1 IF $EXTRACT(IOST)="C"
DO WAIT^DICD
IF $DATA(SDXFLG)
Begin DoDot:1
+2 WRITE !!,?10,"This report option generates a mail message containing the"
+3 WRITE !,?10,"High Risk Mental Health No Show Nightly Report which is sent"
+4 WRITE !,?10,"only to individuals in the SD MH NO SHOW NOTIFICATION mailgroup.",!
End DoDot:1
+5 NEW SDDIV,SDPAG,SDCL,SDSC,SDRLL,SDPAG,NAMSPC,NAMSPC1,SDSTOP,VAUTRR,SDLINE,Y,TOTAL,SDPAT
+6 NEW X
SET X="DGPFAPIH"
XECUTE ^%ZOSF("TEST")
SET X=""
IF '$TEST
Begin DoDot:1
+7 IF '$DATA(SDXFLG)
WRITE !!,"Patch DG*5.3*836 needs to be installed - ICR 4903.",!,"Routines required to run report. Aborting!",!
QUIT
+8 NEW SDX
SET SDX=""
+9 SET SDX=$$SETSTR^SDMHNS1("Patch DG*5.3*836 needs to be installed - ICR 4903.",X,1,80)
DO SET1^SDMHNS1(SDX)
+10 SET SDX=""
SET SDX=$$SETSTR^SDMHNS1("Routines required to run report. Report Aborted!",X,1,80)
DO SET1^SDMHNS1(SDX)
+11 SET SDX=""
End DoDot:1
QUIT
+12 SET Y=0
DO LIST
IF Y=1
QUIT
+13 SET NAMSPC=$$NAMSPC
+14 SET NAMSPC1=$$NAMSPC1
+15 KILL ^TMP(NAMSPC),^TMP(NAMSPC1)
+16 SET (SDPAG,SDCL,SDSC,SDRLL)=0
+17 IF $DATA(SDXFLG)
IF SDXFLG=1
SET VAUTCL=1
+18 IF $DATA(SDXFLG)
DO PXRMD
+19 IF $DATA(SDALL)
IF SDALL="M"
DO PXRMD
+20 IF VAUTD=1
Begin DoDot:1
+21 SET SDDIV=0
FOR SDDIV=0:0
SET SDDIV=$ORDER(^DG(40.8,SDDIV))
IF 'SDDIV
QUIT
IF $DATA(^DG(40.8,SDDIV,0))
SET VAUTD(SDDIV)=$PIECE(^DG(40.8,SDDIV,0),"^",1)
End DoDot:1
+22 IF SDTL'="MEN"
FOR SDCL=0:0
SET SDCL=$ORDER(^SC(SDCL))
IF 'SDCL
QUIT
IF $DATA(^SC(SDCL,0))
IF $PIECE($GET(^SC(SDCL,0)),"^",3)="C"
Begin DoDot:1
+23 ;S ^TMP("SDCLST",$J,SDCL,SDSC)=$P(^SC(SDCL,0),"^",1)
SET SDSC=$PIECE($GET(^SC(SDCL,0)),"^",7)
SET SDDIV=$SELECT('$PIECE($GET(^SC(SDCL,0)),"^",15):"NOT SPECIFIED",1:$PIECE($GET(^SC(SDCL,0)),"^",15))
IF SDSC
DO CHK
End DoDot:1
+24 IF SDTL="MEN"
SET SDRLL=$ORDER(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL",0))
Begin DoDot:1
+25 FOR SDDIV=0:0
SET SDDIV=$ORDER(VAUTRR(SDDIV))
IF 'SDDIV
QUIT
FOR SDSC=0:0
SET SDSC=$ORDER(VAUTRR(SDDIV,SDSC))
IF 'SDSC
QUIT
FOR SDCL=0:0
SET SDCL=$ORDER(VAUTRR(SDDIV,SDSC,SDCL))
IF 'SDCL
QUIT
IF SDCL
DO CHK
End DoDot:1
+26 SET SDLINE=$SELECT($DATA(^TMP(NAMSPC,$JOB)):"PROCESS",1:"END")
+27 DO @SDLINE
+28 GOTO QUIT
+29 ;
+30 ;
PROCESS ;find patients in date range that had a no show appt for a MH clinic.
+1 NEW SDIV,SDC,SDR,SDS,SDHFL,SDUP,SDMHFLG
+2 SET (SDIV,SDC,SDR,SDS,SDUP)=0
+3 SET SDMHFLG=$$GET^XPAR("PKG.REGISTRATION","DGPF SUICIDE FLAG",1,"E")
+4 SET SDMHFLG=$$GETFLAG^DGPFAPIU(SDMHFLG)
+5 FOR SDIV=0:0
SET SDIV=$ORDER(^TMP(NAMSPC,$JOB,SDIV))
IF SDIV=""!(SDUP)
QUIT
FOR SDC=SDC:0
SET SDC=$ORDER(^TMP(NAMSPC,$JOB,SDIV,SDC))
IF SDC=""!(SDUP)
QUIT
FOR SDS=SDS:0
SET SDS=$ORDER(^TMP(NAMSPC,$JOB,SDIV,SDC,SDS))
IF SDS=""!(SDUP)
QUIT
Begin DoDot:1
+6 IF SDTL="MEN"
SET SDR=$PIECE($GET(^TMP(NAMSPC,$JOB,SDIV,SDC,SDS)),"^",4)
+7 NEW SDDT,SDNUM,SDNUM1,DFN,SDSTAT,ACT,SDRR
+8 SET (SDDT,SDNUM,SDNUM1,DFN,SDSTAT)=0
+9 FOR SDDT=SDBEG:0
SET SDDT=$ORDER(^SC(SDC,"S",SDDT))
IF 'SDDT!(SDDT>SDEND)!(SDUP)
QUIT
FOR SDNUM=0:0
SET SDNUM=$ORDER(^SC(SDC,"S",SDDT,SDNUM))
IF 'SDNUM!(SDUP)
QUIT
FOR SDNUM1=0:0
SET SDNUM1=$ORDER(^SC(SDC,"S",SDDT,SDNUM,SDNUM1))
IF 'SDNUM1!(SDUP)
QUIT
Begin DoDot:2
+10 IF '$DATA(^SC(SDC,"S",SDDT,SDNUM,SDNUM1,0))
QUIT
+11 SET DFN=$PIECE($GET(^SC(SDC,"S",SDDT,SDNUM,SDNUM1,0)),"^",1)
IF $DATA(^SC(SDC,"S",SDDT,SDNUM,SDNUM1,"C"))
QUIT
IF $DATA(^DPT(DFN,0))
IF $DATA(^DPT(DFN,"S",SDDT))
SET SDSTAT=$PIECE($GET(^DPT(DFN,"S",SDDT,0)),"^",2)
IF $$GETINF^DGPFAPIH(DFN,SDMHFLG,SDDT,SDDT,"ACT")
Begin DoDot:3
+12 NEW PATNM,SDCLNM,SDDIVNM,SDSCNM,SDZERO
+13 ;S SDXZERO=^DPT(DFN,"S",SDDT,0)
+14 ;S SDDA=$$FIND^SDAM2(DFN,SDDT,SDC)
+15 ;S SDSTAT=$$STATUS^SDAM1(DFN,SDDT,SDNUM,SDXZERO,SDDA)
+16 ;Q:SDSTAT=""
+17 SET SDSTAT=$SELECT(SDSTAT="N":"NS",SDSTAT="NT":"NAT",SDSTAT="NA":"NSA",SDSTAT="":"NAT",1:SDSTAT)
+18 ;I '$D(SDXFLG) I SDSTAT="" S SDSTAT="NT" I "N^NA"'[SDSTAT Q ;!(SDSTAT'="NA")
+19 IF SDSTAT'["N"
QUIT
+20 SET SDDIVNM=$SELECT($PIECE(^DG(40.8,SDIV,0),"^",1)="NOT SPECIFIED":"NOT SPECIFIED",1:$PIECE(^DG(40.8,SDIV,0),"^",1))
+21 SET SDCLNM=$SELECT($PIECE($GET(^SC(SDC,0)),"^",1)="NOT SPECIFIED":"NOT SPECIFIED",1:$PIECE(^SC(SDC,0),"^",1))
+22 SET SDSCNM=$SELECT($PIECE($GET(^DIC(40.7,SDS,0)),"^",1)="NOT SPECIFIED":"NOT SPECIFIED",1:$PIECE(^DIC(40.7,SDS,0),"^",1))
+23 SET PATNM=$SELECT($PIECE($GET(^DPT(DFN,0)),"^",1)="NOT SPECIFIED":"NOT SPECIFIED",1:$PIECE(^DPT(DFN,0),"^",1))
+24 ;D TOTAL(SDDIVNM,SDCLNM)
IF SDTL="CLIN"
SET ^TMP(NAMSPC1,$JOB,SDDIVNM,SDCLNM,PATNM,SDS,SDDT)=DFN_"^"_SDDT_"^"_SDSTAT_"^"_$$PID(DFN)_"^"_SDC_"^"_SDS
+25 IF SDTL="STOP"
SET ^TMP(NAMSPC1,$JOB,SDDIVNM,SDSCNM,PATNM,SDCLNM,SDDT)=DFN_"^"_SDDT_"^"_SDSTAT_"^"_$$PID(DFN)_"^"_SDC_"^"_SDS
+26 IF SDTL="MEN"
SET SDRR=$PIECE(^PXRMD(810.9,SDR,0),"^",1)
SET ^TMP(NAMSPC1,$JOB,SDDIVNM,SDRR,SDCLNM,PATNM,SDDT)=DFN_"^"_SDDT_"^"_SDSTAT_"^"_$$PID(DFN)_"^"_SDC_"^"_SDS
+27 DO TOTAL(SDDIVNM,SDCLNM)
End DoDot:3
IF SDUP
QUIT
End DoDot:2
End DoDot:1
BGJ IF $DATA(SDXFLG)
Begin DoDot:1
+1 IF '$DATA(^TMP(NAMSPC1,$JOB))
DO HEAD^SDMHNS
+2 DO ^SDMHNS1
QUIT
End DoDot:1
QUIT
+3 IF '$DATA(^TMP(NAMSPC1,$JOB))
GOTO END
+4 DO ^SDMHAD1
+5 QUIT
CHK ;Check to see if Division/Clinic/Stop have been selected & if Clinic and Stop code are a valid mental health pair.
+1 NEW SDFLG,SDCLNM,SDDIVNM,SDSCNM
+2 SET SDFLG=0
+3 IF $DATA(VAUTD)
Begin DoDot:1
+4 IF SDDIV="NOT SPECIFIED"
SET SDFLG=1
QUIT
+5 IF 'VAUTD
IF '$DATA(VAUTD(SDDIV))
SET SDFLG=1
QUIT
End DoDot:1
IF SDFLG
QUIT
+6 IF $DATA(VAUTCL)
Begin DoDot:1
+7 IF SDCL="NOT SPECIFIED"
SET SDFLG=1
QUIT
+8 IF 'VAUTCL
IF '$DATA(VAUTCL(SDCL))
SET SDFLG=1
QUIT
End DoDot:1
IF SDFLG
QUIT
+9 IF $DATA(VAUTSC)
Begin DoDot:1
+10 IF SDSC="NOT SPECIFIED"
SET SDFLG=1
QUIT
+11 IF 'VAUTSC
IF '$DATA(VAUTSC(SDSC))
SET SDFLG=1
QUIT
End DoDot:1
IF SDFLG
QUIT
+12 IF '$DATA(^DG(40.8,SDDIV,0))
QUIT
+13 SET SDDIVNM=$SELECT($PIECE($GET(^DG(40.8,SDDIV,0)),"^",1)="":"NOT SPECIFIED",1:$PIECE(^DG(40.8,SDDIV,0),"^",1))
+14 IF '$DATA(^SC(SDCL,0))
QUIT
+15 SET SDCLNM=$SELECT($PIECE($GET(^SC(SDCL,0)),"^",1)="":"NOT SPECIFIED",1:$PIECE(^SC(SDCL,0),"^",1))
+16 IF '$DATA(^DIC(40.7,SDSC,0))
QUIT
+17 SET SDSCNM=$SELECT($PIECE($GET(^DIC(40.7,SDSC,0)),"^",1)="":"NOT SPECIFIED",1:$PIECE(^DIC(40.7,SDSC,0),"^",1))
+18 SET ^TMP(NAMSPC,$JOB,SDDIV,SDCL,SDSC)=SDDIVNM_"^"_SDCLNM_"^"_SDSCNM_"^"_$SELECT(SDRLL="NOT SPECIFIED":"NOT SPECIFIED",1:SDRLL)
+19 QUIT
+20 ;
HEAD ;Heading for the report
+1 WRITE @IOF
+2 WRITE "HIGH RISK MENTAL HEALTH NO SHOW ADHOC REPORT BY",?70,"PAGE "
SET SDPAG=SDPAG+1
WRITE SDPAG,!
+3 WRITE $SELECT(SDTL="MEN":"MH CLINICS",SDTL="STOP":"STOP CODES",1:"CLINICS")_" for Appointments "_$$FMTE^XLFDT(SDBEG,"2")_"-"_$$FMTE^XLFDT($PIECE(SDEND,".",1),"2"),?56,"Run: "_SDDAT
+4 IF $DATA(SDTOTPG)
WRITE !!,"Totals Page"
+5 IF '$DATA(SDTOTPG)
WRITE !!,"PATIENT",?23,"PT ID",?33,"APPT D/T",?53,"CLINIC",?73,"STATUS"
+6 WRITE !,$$LINE(""),!
+7 ;W "*STATUS: NS = No Show NSA = No Show Auto Rebook NAT = No Action Taken",!!
HEAD1 IF $DATA(^TMP(NAMSPC1,$JOB))
IF '$DATA(SDTOTPG)
Begin DoDot:1
+1 NEW SDHEAD2
B IF SDTL'="STOP"
SET SDHEAD2="DIVISION/CLINIC/STOP: "_$EXTRACT(SDXDIV,1,24)_"/"_$EXTRACT(SDXCLIN,1,26)_"/"_$EXTRACT(SDXSTOP,1,4)
+1 ;I SDTL="CLIN" S SDHEAD2="DIVISION/CLINC/STOP CODE: "_SDXDIV_"/"_SDXCLIN_"/"_SDXSTOP
+2 IF SDTL="STOP"
SET SDHEAD2="DIVISION/STOP/CLINIC: "_$EXTRACT(SDXDIV,1,24)_"/"_$EXTRACT(SDXSTOPN,1,4)_"/"_$EXTRACT(SDXCLIN,1,26)
+3 ;I SDTL="STOP" S SDHEAD2="DIVISION/STOP/CLINIC: "_$E(SDXDIV,1,24)_"/"_$E($P($G(^DIC(40.7,$O(^DIC(40.7,"B",SDXSTOP,0)),0)),"^",2),1,4)_"/"_$E(SDXCLIN,1,26)
+4 ;S SDHEAD2=$S(SDTL="MEN":"DIVISION/MH CLIN LIST/CLINIC: "_SDXDIV_"/"_SDXREM,SDTL="CLIN":"DIVISION/CLINIC: "_SDXDIV_"/"_SDXCLIN,1:"DIVISION/STOP CODE: "_SDXDIV_"/"_SDXSTOP_"-"_$P($G(^DIC(40.7,$O(^DIC(40.7,"B",SDXSTOP,0)),0)),"^",2)) W !
+5 WRITE SDHEAD2,!
End DoDot:1
+6 QUIT
+7 ;
+8 ;
RANGE() ;Select Start and End date for report
+1 WRITE !!,$$LINE(" High Risk Mental Health NO SHOW Adhoc Report")
+2 QUIT $$RANGE^SDAMQ(.SDBEG,.SDEND)
+3 ;
DIV() ;Division selection for multidivisional facility
+1 DO ASK2^SDDIV
IF Y<0
KILL VAUTD
+2 QUIT $DATA(VAUTD)>0
+3 ;
LIST NEW X
IF '$DATA(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL"))
Begin DoDot:1
+1 IF '$DATA(SDXFLG)
WRITE !!!,"Reminder location List file is not current.",!,"Missing reminder location list 'VA-MH NO SHOW APPT CLINICS LL' in file 810.9.",!,"Report Aborting!",!
SET Y=1
QUIT
+2 NEW SDX
SET SDX=""
SET X=""
+3 SET SDX=$$SETSTR^SDMHNS1("Reminder location List file is not current.",X,1,80)
DO SET1^SDMHNS1(SDX)
+4 SET SDX=""
SET X=""
SET SDX=$$SETSTR^SDMHNS1("Missing reminder location list 'VA-MH NO SHOW APPT CLINICS LL' in file 810.9.",X,1,80)
DO SET1^SDMHNS1(SDX)
+5 SET SDX=""
SET X=""
SET SDX=$$SETSTR^SDMHNS1("Report Aborted!",X,1,80)
DO SET1^SDMHNS1(SDX)
+6 SET SDX=""
+7 SET Y=1
End DoDot:1
QUIT
LINE(STR) ; Print display prompts
+1 NEW X
+2 IF STR]""
SET STR=" "_STR_" "
+3 SET $PIECE(X,"*",(IOM/2)-($LENGTH(STR)/2))=""
+4 QUIT X_STR_X
+5 ;
LINE1(STR) ; Print display prompts
+1 NEW X
+2 IF STR]""
SET STR=" "_STR_" "
+3 SET $PIECE(X," ",(IOM/2)-($LENGTH(STR)/2))=""
+4 QUIT X_STR_X
+5 ;
+6 ;
TOTAL(DIV,CLST) ;INITIALIZE total(DIV,CLIN/STOP)
+1 IF '$DATA(TOTAL(DIV,CLST))
Begin DoDot:1
+2 NEW SDCNTT
SET SDCNTT=0
+3 SET TOTAL(DIV,CLST)="0^0^0^0^0"
End DoDot:1
+4 IF $DATA(TOTAL(DIV,CLST))
Begin DoDot:1
+5 SET $PIECE(TOTAL(DIV,CLST),"^",1)=$PIECE($GET(TOTAL(DIV,CLST)),"^",1)+1
+6 NEW X
SET X=$SELECT(SDSTAT="NS":2,SDSTAT="NSA":3,1:4)
SET $PIECE(TOTAL(DIV,CLST),"^",X)=$PIECE(TOTAL(DIV,CLST),"^",X)+1
+7 IF '$DATA(SDPAT(DIV,CLST,DFN))
SET SDPAT(DIV,CLST,DFN)=""
SET $PIECE(TOTAL(DIV,CLST),"^",5)=$PIECE(TOTAL(DIV,CLST),"^",5)+1
End DoDot:1
+8 QUIT
+9 ;
+10 ;
CLIN ;select clinics
+1 WRITE !!,"Clinic Selection:",!,?20,"A All clinics",!,?20,"M Mental Health clinics only",!
CL1 READ !,"Select: (A)ll clinics A//",X:DTIME
IF X["^"!('$TEST)
SET Y=-1
IF Y=-1
QUIT
SET X=$SELECT(X="":"A",1:$EXTRACT(X))
IF "AMam"'[X
WRITE !,?6,"Enter : 'A' for All clinics",!,?14,"'M' for Mental Health clinics only"
GOTO CL1
+1 SET SDALL=X
+2 NEW DIC,K,VAUTVB,VAUTSTR,VAUTNI
+3 SET VAUTVB="VAUTCL"
SET DIC="^SC("
+4 IF SDALL="M"
SET DIC("S")="N X,K S X=$O(^PXRMD(810.9,""B"",""VA-MH NO SHOW APPT CLINICS LL"",0)) I $D(^SC(+Y,0)) S K=$P(^SC(+Y,0),""^"",7) I $D(^PXRMD(810.9,X,40.7,""B"",+K))"
+5 SET VAUTSTR="Clinic"
SET VAUTNI=2
DO FIRST^VAUTOMA
IF Y=-1
SET SDFL=1
IF $DATA(SDFL)
QUIT
+6 QUIT
+7 ;
STOP NEW SDFL,DIC,K,VAUTVB,VAUTSTR,VAUTNI
+1 WRITE !!,"Stop Code Selection:",!,?20,"A All Stop Codes",!,?20,"M Mental Health Stop Codes only",!
ST1 READ !,"Select: (A)ll Stop Codes A//",X:DTIME
IF X["^"!('$TEST)
SET Y=-1
IF Y=-1
QUIT
SET X=$SELECT(X="":"A",1:$EXTRACT(X))
IF "AMam"'[X
WRITE !,?6,"Enter: 'A' for All Stop Codes",!,?14,"'M' for Mental Health Stop Codes only"
GOTO ST1
+1 SET SDALL=X
+2 SET VAUTVB="VAUTSC"
SET DIC="^DIC(40.7,"
+3 IF SDALL="M"
SET DIC("S")="N X S X=$O(^PXRMD(810.9,""B"",""VA-MH NO SHOW APPT CLINICS LL"",0)) I $D(^PXRMD(810.9,X,40.7,""B"",+Y))"
+4 SET VAUTSTR="Stop codes"
SET VAUTNI=2
DO FIRST^VAUTOMA
+5 QUIT
STOP1 NEW SDFL,DIC,K,VAUTVB,VAUTSTR,VAUTNI
+1 SET VAUTVB="VAUTSC"
SET DIC="^DIC(40.7,"
SET DIC("S")="S SDFL=0 D MEN1^SDMHAD I SDFL"
SET VAUTSTR="Stop codes"
SET VAUTNI=2
DO FIRST^VAUTOMA
+2 QUIT
+3 ;
MEN SET VAUTR=0
MEN1 NEW X
SET X=$ORDER(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL",0))
SET VAUTR(X)=$PIECE($GET(^PXRMD(810.9,X,0)),"^",1)
+1 IF SDTL="STOP"
Begin DoDot:1
+2 IF $DATA(^PXRMD(810.9,X,40.7,"B",+Y))
SET SDFL=1
+3 QUIT
End DoDot:1
+4 QUIT
+5 ;
PID(DFN) ; Return PID
+1 ; INPUT - DFN
+2 ; OUTPUT - PID or 'UNKNOWN'
+3 NEW VA
+4 DO PID^VADPT6
+5 QUIT $SELECT(VA("BID")]"":VA("BID"),1:"UNKNOWN")
+6 ;
NAMSPC() ; API returns the name space for this patch
+1 QUIT "SDNSHOW"
NAMSPC1() ; API returns the name space for this patch
+1 QUIT "SDNS"
PXRMD ;Set up Reminder Location List valid Stop Codes for No Show Report
+1 NEW SDX,SDY,SDI,SDSFL,SDCFL
+2 SET SDY=0
+3 SET SDX=$ORDER(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL",0))
IF SDX']""
QUIT
FOR
SET SDY=$ORDER(^PXRMD(810.9,SDX,40.7,"B",SDY))
IF SDY']""
QUIT
Begin DoDot:1
+4 SET SDSTOP(+SDY)=""
+5 IF SDTL="MEN"
NEW SDI
SET SDI=0
FOR
SET SDI=$ORDER(^SC("AST",+SDY,SDI))
IF SDI']""
QUIT
SET VAUTRR(+$PIECE($GET(^SC(+SDI,0)),"^",15),+SDY,+SDI)=""
+6 IF $DATA(VAUTSC)
IF $GET(VAUTSC)=1
SET VAUTSC(+SDY)=$PIECE($GET(^DIC(40.7,+SDY,0)),"^",1)
SET SDSFL=1
+7 IF $DATA(VAUTCL)
IF $GET(VAUTCL)=1
NEW SDI
SET SDI=0
FOR
SET SDI=$ORDER(^SC("AST",+SDY,SDI))
IF SDI']""
QUIT
Begin DoDot:2
+8 SET VAUTCL(+SDI)=$PIECE($GET(^SC(+SDI,0)),"^",1)
SET SDCFL=1
End DoDot:2
End DoDot:1
+9 IF $DATA(SDSFL)
SET VAUTSC=0
+10 IF $DATA(SDCFL)
SET VAUTCL=0
+11 QUIT
END ;NO RECORDS
+1 DO HEAD
+2 WRITE !!,$$LINE1(">>>>>> NO RECORDS FOUND <<<<<<")
QUIT KILL %DT,DIR,SDTBEG,SDTEND,SDDIV,VAUTD,VAUTCL,VAUTR,VAUTSC,VADAT,VADATE,POP,X,Y
+1 KILL ^TMP("SDNSHOW",$JOB),^TMP("SDNS",$JOB)
+2 DO CLOSE^DGUTQ
QUIT
