BSDLTP ;ALB/LDB - PRINT SCHEDULING LETTERS ; [ 01/02/2004 9:07 AM ]
;;5.3;Scheduling;**79,106,170,80,1013**;Aug 13, 1993
;IHS/ANMC/LJF 8/18/2000 set DIC(W) to warn if clinic inactivated
; added variables to kill list
;ihs/cmi/maw 05/02/2011 added W to allowable letters to print
;
MAIN(L0) ;-- pass i letter type
I L0="W" G R2
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^W^""[(""^""_$P($G(^(0)),U)_""^"")" D ^DIC G:Y'>0 EXIT S L0=Y(0,0) K DIC,DA ;ihs/cmi/maw 5/2/2011 PATCH 1013 added W
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
S L0="W"
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",L0="W":"WLLET",1:"PCNLET")_"^SDDIV") G:+Y<0 R S SDV1=+Y ;ihs/cmi/maw P1013
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
I L0="W" Q ;ihs/cmi/maw 05/02/2011 PATCH 1013 select numbers to print and then quit
S VAUTNI=2 I "APW"[L0!(L0="C"&(SD9)) D PC G:S1=-1 R I "Pp"[S1 D PAT G R:Y<0,DATE ;ihs/cmi/maw 05/02/2011 added W
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
;IHS/ITSC/WAR 11/6/03 Commented out 1 line, beginnig with I L0="P"
DATE ;N %DT 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")
;I L0="P" S SDBD=DT,SDED=$$FMADD^XLFDT(DT,365) S L2="^SDL1" G QUE ;IHS/ANMC/LJF 11/02/2001 don't ask dates for pre-appt letters
I L0="P" S SDT00="AEF" ;IHS/ITSC/LJF 1/2/04 assume future dates for pre-appt letters
N %DT 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",L0="W":"^SDL1",1:"^SDCNL") ;ihs/cmi/maw 05/02/2011 added W
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
D KVA^VADPT,KILL^AUPNPAT K SDT00 ;IHS/ANMC/LJF 8/18/2000
K SDX1,VAUTC,VAUTN,VAUTNI,VAUTD,SDVAUTC,X,XX,Y,W,Z0,Z5,^UTILITY("SDLT"),^UTILITY($J,"W") 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("W")=$$INACTMSG^BSDU ;IHS/ANMC/LJF 8/18/2000
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
SEL ;-- select the entries on the list manager screen to print
Q
;
BSDLTP ;ALB/LDB - PRINT SCHEDULING LETTERS ; [ 01/02/2004 9:07 AM ]
+1 ;;5.3;Scheduling;**79,106,170,80,1013**;Aug 13, 1993
+2 ;IHS/ANMC/LJF 8/18/2000 set DIC(W) to warn if clinic inactivated
+3 ; added variables to kill list
+4 ;ihs/cmi/maw 05/02/2011 added W to allowable letters to print
+5 ;
MAIN(L0) ;-- pass i letter type
+1 IF L0="W"
GOTO R2
R ;ihs/cmi/maw 5/2/2011 PATCH 1013 added W
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^W^""[(""^""_$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
+1 SET L0="W"
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 ;ihs/cmi/maw P1013
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",L0="W":"WLLET",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 ;ihs/cmi/maw 05/02/2011 PATCH 1013 select numbers to print and then quit
IF L0="W"
QUIT
+2 ;ihs/cmi/maw 05/02/2011 added W
SET VAUTNI=2
IF "APW"[L0!(L0="C"&(SD9))
DO PC
IF S1=-1
GOTO R
IF "Pp"[S1
DO PAT
IF Y<0
GOTO R
GOTO DATE
+3 SET SDCONC="B"
IF L0="P"
DO NCOUNT^SDAL0
IF SDCONC=U
GOTO R
+4 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
+5 ;IHS/ITSC/WAR 11/6/03 Commented out 1 line, beginnig with I L0="P"
DATE ;N %DT 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")
+1 ;I L0="P" S SDBD=DT,SDED=$$FMADD^XLFDT(DT,365) S L2="^SDL1" G QUE ;IHS/ANMC/LJF 11/02/2001 don't ask dates for pre-appt letters
+2 ;IHS/ITSC/LJF 1/2/04 assume future dates for pre-appt letters
IF L0="P"
SET SDT00="AEF"
+3 ;ihs/cmi/maw 05/02/2011 added W
NEW %DT
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",L0="W":"^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 ;IHS/ANMC/LJF 8/18/2000
DO KVA^VADPT
DO KILL^AUPNPAT
KILL SDT00
+2 KILL SDX1,VAUTC,VAUTN,VAUTNI,VAUTD,SDVAUTC,X,XX,Y,W,Z0,Z5,^UTILITY("SDLT"),^UTILITY($JOB,"W")
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 ;
+1 ;IHS/ANMC/LJF 8/18/2000
SET DIC("W")=$$INACTMSG^BSDU
+2 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
+3 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
+4 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
SEL ;-- select the entries on the list manager screen to print
+1 QUIT
+2 ;
