SDLTP ;ALB/LDB - PRINT SCHEDULING LETTERS ; 11/27/00 1:53pm
;;5.3;Scheduling;**79,106,170,80,356,398**;Aug 13, 1993
R D EXIT S SD9=0,SDLT=1,DIC=407.6,DIC(0)="AEQMZ",DIC("A")="SELECT THE TYPE OF LETTER TO PRINT: ",DIC("S")="I ""^A^C^N^P^""[(""^""_$P($G(^(0)),U)_""^"")" D ^DIC G:Y'>0 EXIT S L0=Y(0,0) K DIC,DA
R1 R !,"PRINT LETTER ASSIGNED TO THE CLINIC(S)" S %=1 D YN^DICN G:'% HELP1 G:%<0 EXIT I %=1 S SDLET=0 G DIV
R2 K DIC,X,Y S DIC=407.5,DIC("S")="I $P(^(0),""^"",2)="_""""_L0_"""",DIC(0)="AEQMZ" D ^DIC G:Y'>0 EXIT S SDLET=+Y
DIV S SDLT1=SDLET,SDV1=$O(^DG(40.8,0)) K DIC,X,Y I $D(^DG(43,1,"GL")),$P(^("GL"),"^",2) S DIC=40.8,DIC(0)="AEQM" D @($S(L0="P":"PALST",L0="C":"CNLET",L0="N":"NSLET1",1:"PCNLET")_"^SDDIV") G:+Y<0 R S SDV1=+Y
S VAUTD=0,VAUTD(SDV1)=$P(^DG(40.8,SDV1,0),"^"),SDFORM=0,SDTIME="*" I $D(^DG(40.8,SDV1,"LTR")),^("LTR") S SDFORM=1
L0 I L0="C" D IND G:$D(DTOUT)!(%=-1) R
S VAUTNI=2 I "AP"[L0!(L0="C"&(SD9)) D PC G:S1=-1 R I "Pp"[S1 D PAT G R:Y<0,DATE
S SDCONC="B" I L0="P" D NCOUNT^SDAL0 I SDCONC=U G R
D NCLINIC^SDAL0 G:Y<0 R I VAUTC D EX G:%Y="^"!($D(DTOUT)) R I $D(X),X="^" G R
DATE N %DT I L0="P" S SDT00="AEF"
D DATE^SDUTL G:POP&('$D(SDBD)) EXIT G:POP&(X="^") EXIT S:'$D(SDED) SDED=SDBD S L2=$S(L0="C"&('SD9):"BEG1^SDC0",L0="N":"BC^SDN1",L0="P":"^SDL1",1:"^SDCNL")
QUE S DGPGM=L2,DGVAR="SDCONC^SDLT^SDFORM^SDV1^SDLT1^SDLET^VAUTD#^SDBD^SDED"_$S($D(VAUTNALL):"^VAUTNALL",1:"")_$S($D(VAUTC):"^VAUTC#",1:"")_$S($D(VAUTN):"^VAUTN#",1:"")
S DGVAR=DGVAR_$S(L2="^SDCNL":"^SD9",1:"^SDTIME")_$S($D(S1):"^S1",1:"")_$S($D(SDVAUTC):"^SDVAUTC#",1:"")
D ZIS^DGUTQ G:POP EXIT
U IO D @L2
EXIT K %,%Y,A2,BEGDATE,C,DIC,DGPGM,DGVAR,DIV,DIW,DIWF,DIWL,DIWR,DIWT,ENDDATE,ENDATE,L,LL,L0,L2,POP,S1,SD9,SDC,SDDAT,SDCL,SC,SDADD,SDARRAY,SDTADB,SDTADE,SDBD,SDCONC,SDCNT,SDD,SDED,SDHX,SDIV,SDFORM,SDLET,SDLT1,SDLT,SDMDT,SDT0,SDTIME,SDV,SDV1,SDX
K SDX1,VAUTC,VAUTN,VAUTNI,VAUTD,SDVAUTC,X,XX,Y,W,Z0,Z5,^UTILITY("SDLT"),^UTILITY($J,"W"),^TMP($J,"BADADD") D CLOSE^DGUTQ Q
HELP W !,"LETTER TYPE MUST EXIST IN LETTERS TYPE FILE!" S DIC=407.6 K DIC("S") D ^DIC G R
HELP1 W !,"If you want to print another letter for the selected clinic(s), you must answer",!,"""N"""_" and select another letter of the appropriate type. If you do this, that ",!,"letter will print for (ALL) the selected clinic(s)." G R1
PC R !,"Enter 'P' for individual PATIENT letters or 'C' for letters by CLINIC: P// ",S1:DTIME S:S1["^"!('$T) S1=-1 Q:S1=-1 S:S1="" S1="P" I "PCpc"'[S1 W "??" D HELP2 G PC
Q
HELP2 W !,"Entering 'P' will allow you to select PATIENT(S) and entering a 'C' will allow",!,"you to select CLINIC(S)." Q
PAT S VAUTNI=2,VAUTNALL=1 D PATIENT^VAUTOMA Q
EX S SDCNT=0 W !,"Do you want to exclude any Clinic(s)" S %=2 D YN^DICN I '% W !,"RESPOND YES OR NO" G EX
K SDVAUTC Q:%-1
EXASK S DIC=44,DIC(0)="AEQM",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))",DIC("A")="Select Clinic to be excluded: " D ^DIC K DIC("A"),DIC("S") Q:"^"[X G:Y<0 EXASK I $D(SDVAUTC(+Y)) W !,*7,"THIS CLINIC HAS ALREADY BEEN SELECTED!" G EXASK
S SDCNT=SDCNT+1,SDVAUTC(+Y)="" W " ...OK" W:SDCNT'<10 !,*7,"ONLY TEN CLINICS ARE ALLOWED TO BE SELECTED!" G:SDCNT<10 EXASK
Q
MAX W !,*7,"NO MORE THAN TEN CLINICS ALLOWED TO BE EXCLUDED" Q
IND S %=1,SD9=0 W !,"DID CLINIC CANCEL AVAILABILITY" D YN^DICN I '% D HLP3 G IND
S:%-1 SD9=1 Q
HLP3 W !!,"If the clinic was cancelled for any length of time respond 'Y'.",!,"If individual appointments were cancelled without cancelling the clinic respond 'N'",! Q
W !,"CLINIC CANCELLATION LETTERS will be selectable with 'C' response.",! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDLTP 3579 printed Oct 16, 2024@18:58:38 Page 2
SDLTP ;ALB/LDB - PRINT SCHEDULING LETTERS ; 11/27/00 1:53pm
+1 ;;5.3;Scheduling;**79,106,170,80,356,398**;Aug 13, 1993
R DO EXIT
SET SD9=0
SET SDLT=1
SET DIC=407.6
SET DIC(0)="AEQMZ"
SET DIC("A")="SELECT THE TYPE OF LETTER TO PRINT: "
SET DIC("S")="I ""^A^C^N^P^""[(""^""_$P($G(^(0)),U)_""^"")"
DO ^DIC
if Y'>0
GOTO EXIT
SET L0=Y(0,0)
KILL DIC,DA
R1 READ !,"PRINT LETTER ASSIGNED TO THE CLINIC(S)"
SET %=1
DO YN^DICN
if '%
GOTO HELP1
if %<0
GOTO EXIT
IF %=1
SET SDLET=0
GOTO DIV
R2 KILL DIC,X,Y
SET DIC=407.5
SET DIC("S")="I $P(^(0),""^"",2)="_""""_L0_""""
SET DIC(0)="AEQMZ"
DO ^DIC
if Y'>0
GOTO EXIT
SET SDLET=+Y
DIV SET SDLT1=SDLET
SET SDV1=$ORDER(^DG(40.8,0))
KILL DIC,X,Y
IF $DATA(^DG(43,1,"GL"))
IF $PIECE(^("GL"),"^",2)
SET DIC=40.8
SET DIC(0)="AEQM"
DO @($SELECT(L0="P":"PALST",L0="C":"CNLET",L0="N":"NSLET1",1:"PCNLET")_"^SDDIV")
if +Y<0
GOTO R
SET SDV1=+Y
+1 SET VAUTD=0
SET VAUTD(SDV1)=$PIECE(^DG(40.8,SDV1,0),"^")
SET SDFORM=0
SET SDTIME="*"
IF $DATA(^DG(40.8,SDV1,"LTR"))
IF ^("LTR")
SET SDFORM=1
L0 IF L0="C"
DO IND
if $DATA(DTOUT)!(%=-1)
GOTO R
+1 SET VAUTNI=2
IF "AP"[L0!(L0="C"&(SD9))
DO PC
if S1=-1
GOTO R
IF "Pp"[S1
DO PAT
if Y<0
GOTO R
GOTO DATE
+2 SET SDCONC="B"
IF L0="P"
DO NCOUNT^SDAL0
IF SDCONC=U
GOTO R
+3 DO NCLINIC^SDAL0
if Y<0
GOTO R
IF VAUTC
DO EX
if %Y="^"!($DATA(DTOUT))
GOTO R
IF $DATA(X)
IF X="^"
GOTO R
DATE NEW %DT
IF L0="P"
SET SDT00="AEF"
+1 DO DATE^SDUTL
if POP&('$DATA(SDBD))
GOTO EXIT
if POP&(X="^")
GOTO EXIT
if '$DATA(SDED)
SET SDED=SDBD
SET L2=$SELECT(L0="C"&('SD9):"BEG1^SDC0",L0="N":"BC^SDN1",L0="P":"^SDL1",1:"^SDCNL")
QUE SET DGPGM=L2
SET DGVAR="SDCONC^SDLT^SDFORM^SDV1^SDLT1^SDLET^VAUTD#^SDBD^SDED"_$SELECT($DATA(VAUTNALL):"^VAUTNALL",1:"")_$SELECT($DATA(VAUTC):"^VAUTC#",1:"")_$SELECT($DATA(VAUTN):"^VAUTN#",1:"")
+1 SET DGVAR=DGVAR_$SELECT(L2="^SDCNL":"^SD9",1:"^SDTIME")_$SELECT($DATA(S1):"^S1",1:"")_$SELECT($DATA(SDVAUTC):"^SDVAUTC#",1:"")
+2 DO ZIS^DGUTQ
if POP
GOTO EXIT
+3 USE IO
DO @L2
EXIT KILL %,%Y,A2,BEGDATE,C,DIC,DGPGM,DGVAR,DIV,DIW,DIWF,DIWL,DIWR,DIWT,ENDDATE,ENDATE,L,LL,L0,L2,POP,S1,SD9,SDC,SDDAT,SDCL,SC,SDADD,SDARRAY,SDTADB,SDTADE,SDBD,SDCONC,SDCNT,SDD,SDED,SDHX,SDIV,SDFORM,SDLET,SDLT1,SDLT,SDMDT,SDT0,SDTIME,SDV,SDV1,SDX
+1 KILL SDX1,VAUTC,VAUTN,VAUTNI,VAUTD,SDVAUTC,X,XX,Y,W,Z0,Z5,^UTILITY("SDLT"),^UTILITY($JOB,"W"),^TMP($JOB,"BADADD")
DO CLOSE^DGUTQ
QUIT
HELP WRITE !,"LETTER TYPE MUST EXIST IN LETTERS TYPE FILE!"
SET DIC=407.6
KILL DIC("S")
DO ^DIC
GOTO R
HELP1 WRITE !,"If you want to print another letter for the selected clinic(s), you must answer",!,"""N"""_" and select another letter of the appropriate type. If you do this, that ",!,"letter will print for (ALL) the selected clinic(s)."
GOTO R1
PC READ !,"Enter 'P' for individual PATIENT letters or 'C' for letters by CLINIC: P// ",S1:DTIME
if S1["^"!('$TEST)
SET S1=-1
if S1=-1
QUIT
if S1=""
SET S1="P"
IF "PCpc"'[S1
WRITE "??"
DO HELP2
GOTO PC
+1 QUIT
HELP2 WRITE !,"Entering 'P' will allow you to select PATIENT(S) and entering a 'C' will allow",!,"you to select CLINIC(S)."
QUIT
PAT SET VAUTNI=2
SET VAUTNALL=1
DO PATIENT^VAUTOMA
QUIT
EX SET SDCNT=0
WRITE !,"Do you want to exclude any Clinic(s)"
SET %=2
DO YN^DICN
IF '%
WRITE !,"RESPOND YES OR NO"
GOTO EX
+1 KILL SDVAUTC
if %-1
QUIT
EXASK SET DIC=44
SET DIC(0)="AEQM"
SET DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
SET DIC("A")="Select Clinic to be excluded: "
DO ^DIC
KILL DIC("A"),DIC("S")
if "^"[X
QUIT
if Y<0
GOTO EXASK
IF $DATA(SDVAUTC(+Y))
WRITE !,*7,"THIS CLINIC HAS ALREADY BEEN SELECTED!"
GOTO EXASK
+1 SET SDCNT=SDCNT+1
SET SDVAUTC(+Y)=""
WRITE " ...OK"
if SDCNT'<10
WRITE !,*7,"ONLY TEN CLINICS ARE ALLOWED TO BE SELECTED!"
if SDCNT<10
GOTO EXASK
+2 QUIT
MAX WRITE !,*7,"NO MORE THAN TEN CLINICS ALLOWED TO BE EXCLUDED"
QUIT
IND SET %=1
SET SD9=0
WRITE !,"DID CLINIC CANCEL AVAILABILITY"
DO YN^DICN
IF '%
DO HLP3
GOTO IND
+1 if %-1
SET SD9=1
QUIT
HLP3 WRITE !!,"If the clinic was cancelled for any length of time respond 'Y'.",!,"If individual appointments were cancelled without cancelling the clinic respond 'N'",!
QUIT
+1 WRITE !,"CLINIC CANCELLATION LETTERS will be selectable with 'C' response.",!
QUIT
