SDAM3 ;MJK/ALB - Appt Mgt (Clinic) ; 4/21/05 12:23pm
;;5.3;Scheduling;**63,189,380,478,492,1003,1015**;Aug 13, 1993;Build 21
;IHS/ANMC/LJF 8/18/2000 added warnings that clinic was inactivated
; 7/12/2001 changed default list to all appts
;IHS/ITSC/LJF 6/17/2005 PATCH 1003 allow appt threshold of zero
;
INIT ; -- get init clinic appt data
; input: SDCLN := ifn of pat
; output: ^TMP("SDAM" := appt array
;
I '$$ACTV^BSDU(SDCLN,DT) D ;IHS/ANMC/LJF 8/18/2000
. S X="** Inactivated on "_$$INACTVDT^BSDU(SDCLN)_" **" ;IHS/ANMC/LJF 8/18/2000
. D EN^DDIOL(.X) ;IHS/ANMC/LJF 8/18/2000
;
;IHS/ITSC/LJF 6/17/2005 PATCH 1003
;S X=$P($G(^DG(43,1,"SCLR")),U,12),SDPRD=$S(X:X,1:2)
S X=$P($G(^DG(43,1,"SCLR")),U,12),SDPRD=$S(X]"":X,1:2)
S X1=DT,X2=-SDPRD D C^%DTC S VALMB=X D RANGE^VALM11
I '$D(VALMBEG) S VALMQUIT="" G INITQ
S SDBEG=VALMBEG,SDEND=VALMEND
D CHGCAP^VALM("NAME","Patient")
;IHS/ANMC/LJF 7/12/2001 default to all appts
;S X="NO ACTION TAKEN" D LIST^SDAM
S X="ALL" D LIST^SDAM
;IHS/ANMC/LJF 7/12/2001 end of changes
;
INITQ K VALMB,VALMBEG,VALMEND Q
;
BLD ; -- scan apts
N VA,SDAMDD,SDNAME,SDMAX,SDLARGE,DFN,SDCL,BL,XC,XW,AC,AW,TC,TW,NC,NW,SC,SW,SDT,SDDA ; done for speed see INIT^SDAM10
D INIT^SDAM10
F SDT=SDBEG:0 S SDT=$O(^SC(SDCLN,"S",SDT)) Q:'SDT!($P(SDT,".",1)>SDEND) D
.F SDDA=0:0 S SDDA=$O(^SC(SDCLN,"S",SDT,1,SDDA)) Q:'SDDA S CNSTLNK=$P($G(^SC(SDCLN,"S",SDT,1,SDDA,"CONS")),U),CSTAT="" S:CNSTLNK'="" CSTAT=$P($G(^GMR(123,CNSTLNK,0)),U,12) D ;SD/478
..I $D(^SC(SDCLN,"S",SDT,1,SDDA,0)) S DFN=+^(0) D ;SD/492
...N NDX,DA,FND ;SD/492
...S (FND,NDX)="" ;SD/492
...F S NDX=$O(^TMP("SDAMIDX",$J,NDX)) Q:NDX="" D Q:FND ;SD/492
....S DA=^TMP("SDAMIDX",$J,NDX) ;SD/492
....I $P(DA,U,2)=DFN,$P(DA,U,3)=SDT,$P(DA,U,4)=SDCLN S FND=1 ;SD/492
...Q:FND ;SD/492
...D PID^VADPT I $D(^DPT(DFN,"S",SDT,0)),$$VALID^SDAM2(DFN,SDCLN,SDT,SDDA) S SDATA=^DPT(DFN,"S",SDT,0),SDCL=SDCLN,SDNAME=VA("BID")_" "_$P($G(^DPT(DFN,0)),U) D:SDCLN=+SDATA BLD1^SDAM1 ;SD/478,492
D NUL^SDAM10,LARGE^SDAM10:$D(SDLARGE)
S $P(^TMP("SDAM",$J,0),U,4)=VALMCNT
Q
;
HDR ; -- list screen header
; input: SDCLN := ifn of pat
; output: VALMHDR() := hdr array
;
S VALMHDR(1)=$E($P("Clinic: "_$G(^SC(SDCLN,0)),"^",1),1,45) ;for proper display of clinic name for SD*5.3*189
Q
;
CLN ; -- change clinic
I $G(SDAMLIST)["CANCELLED" S VALMBCK="" W !!,*7,"You must be viewing a patient to list cancelled appointments." D PAUSE^VALM1 G CLNQ
D FULL^VALM1 S VALMBCK="R"
S X="" I $D(XQORNOD(0)) S X=$P($P(XQORNOD(0),U,4),"=",2)
W ! S DIC="^SC(",DIC(0)=$S(X]"":"",1:"A")_"EMQ",DIC("A")="Select Clinic: ",DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))"
D ^DIC K DIC
I Y<0 D G CLNQ
.I SDAMTYP="C" S VALMSG=$C(7)_"Clinic has not been changed."
.I SDAMTYP="P" S VALMSG=$C(7)_"View of patient remains in affect."
I SDAMTYP'="C" D CHGCAP^VALM("NAME","Patient") S SDAMTYP="C"
N SDRES I SDAMTYP="C" S SDRES=$$CLNCK^SDUTL2(+Y,1) I 'SDRES D G CLNQ
.W !,?5,"Clinic MUST be corrected before continuing." D PAUSE^VALM1
S SDCLN=+Y K SDFN D BLD
CLNQ Q
;
SDAM3 ;MJK/ALB - Appt Mgt (Clinic) ; 4/21/05 12:23pm
+1 ;;5.3;Scheduling;**63,189,380,478,492,1003,1015**;Aug 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 8/18/2000 added warnings that clinic was inactivated
+3 ; 7/12/2001 changed default list to all appts
+4 ;IHS/ITSC/LJF 6/17/2005 PATCH 1003 allow appt threshold of zero
+5 ;
INIT ; -- get init clinic appt data
+1 ; input: SDCLN := ifn of pat
+2 ; output: ^TMP("SDAM" := appt array
+3 ;
+4 ;IHS/ANMC/LJF 8/18/2000
IF '$$ACTV^BSDU(SDCLN,DT)
Begin DoDot:1
+5 ;IHS/ANMC/LJF 8/18/2000
SET X="** Inactivated on "_$$INACTVDT^BSDU(SDCLN)_" **"
+6 ;IHS/ANMC/LJF 8/18/2000
DO EN^DDIOL(.X)
End DoDot:1
+7 ;
+8 ;IHS/ITSC/LJF 6/17/2005 PATCH 1003
+9 ;S X=$P($G(^DG(43,1,"SCLR")),U,12),SDPRD=$S(X:X,1:2)
+10 SET X=$PIECE($GET(^DG(43,1,"SCLR")),U,12)
SET SDPRD=$SELECT(X]"":X,1:2)
+11 SET X1=DT
SET X2=-SDPRD
DO C^%DTC
SET VALMB=X
DO RANGE^VALM11
+12 IF '$DATA(VALMBEG)
SET VALMQUIT=""
GOTO INITQ
+13 SET SDBEG=VALMBEG
SET SDEND=VALMEND
+14 DO CHGCAP^VALM("NAME","Patient")
+15 ;IHS/ANMC/LJF 7/12/2001 default to all appts
+16 ;S X="NO ACTION TAKEN" D LIST^SDAM
+17 SET X="ALL"
DO LIST^SDAM
+18 ;IHS/ANMC/LJF 7/12/2001 end of changes
+19 ;
INITQ KILL VALMB,VALMBEG,VALMEND
QUIT
+1 ;
BLD ; -- scan apts
+1 ; done for speed see INIT^SDAM10
NEW VA,SDAMDD,SDNAME,SDMAX,SDLARGE,DFN,SDCL,BL,XC,XW,AC,AW,TC,TW,NC,NW,SC,SW,SDT,SDDA
+2 DO INIT^SDAM10
+3 FOR SDT=SDBEG:0
SET SDT=$ORDER(^SC(SDCLN,"S",SDT))
IF 'SDT!($PIECE(SDT,".",1)>SDEND)
QUIT
Begin DoDot:1
+4 ;SD/478
FOR SDDA=0:0
SET SDDA=$ORDER(^SC(SDCLN,"S",SDT,1,SDDA))
IF 'SDDA
QUIT
SET CNSTLNK=$PIECE($GET(^SC(SDCLN,"S",SDT,1,SDDA,"CONS")),U)
SET CSTAT=""
IF CNSTLNK'=""
SET CSTAT=$PIECE($GET(^GMR(123,CNSTLNK,0)),U,12)
Begin DoDot:2
+5 ;SD/492
IF $DATA(^SC(SDCLN,"S",SDT,1,SDDA,0))
SET DFN=+^(0)
Begin DoDot:3
+6 ;SD/492
NEW NDX,DA,FND
+7 ;SD/492
SET (FND,NDX)=""
+8 ;SD/492
FOR
SET NDX=$ORDER(^TMP("SDAMIDX",$JOB,NDX))
IF NDX=""
QUIT
Begin DoDot:4
+9 ;SD/492
SET DA=^TMP("SDAMIDX",$JOB,NDX)
+10 ;SD/492
IF $PIECE(DA,U,2)=DFN
IF $PIECE(DA,U,3)=SDT
IF $PIECE(DA,U,4)=SDCLN
SET FND=1
End DoDot:4
IF FND
QUIT
+11 ;SD/492
IF FND
QUIT
+12 ;SD/478,492
DO PID^VADPT
IF $DATA(^DPT(DFN,"S",SDT,0))
IF $$VALID^SDAM2(DFN,SDCLN,SDT,SDDA)
SET SDATA=^DPT(DFN,"S",SDT,0)
SET SDCL=SDCLN
SET SDNAME=VA("BID")_" "_$PIECE($GET(^DPT(DFN,0)),U)
IF SDCLN=+SDATA
DO BLD1^SDAM1
End DoDot:3
End DoDot:2
End DoDot:1
+13 DO NUL^SDAM10
IF $DATA(SDLARGE)
DO LARGE^SDAM10
+14 SET $PIECE(^TMP("SDAM",$JOB,0),U,4)=VALMCNT
+15 QUIT
+16 ;
HDR ; -- list screen header
+1 ; input: SDCLN := ifn of pat
+2 ; output: VALMHDR() := hdr array
+3 ;
+4 ;for proper display of clinic name for SD*5.3*189
SET VALMHDR(1)=$EXTRACT($PIECE("Clinic: "_$GET(^SC(SDCLN,0)),"^",1),1,45)
+5 QUIT
+6 ;
CLN ; -- change clinic
+1 IF $GET(SDAMLIST)["CANCELLED"
SET VALMBCK=""
WRITE !!,*7,"You must be viewing a patient to list cancelled appointments."
DO PAUSE^VALM1
GOTO CLNQ
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 SET X=""
IF $DATA(XQORNOD(0))
SET X=$PIECE($PIECE(XQORNOD(0),U,4),"=",2)
+4 WRITE !
SET DIC="^SC("
SET DIC(0)=$SELECT(X]"":"",1:"A")_"EMQ"
SET DIC("A")="Select Clinic: "
SET DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))"
+5 DO ^DIC
KILL DIC
+6 IF Y<0
Begin DoDot:1
+7 IF SDAMTYP="C"
SET VALMSG=$CHAR(7)_"Clinic has not been changed."
+8 IF SDAMTYP="P"
SET VALMSG=$CHAR(7)_"View of patient remains in affect."
End DoDot:1
GOTO CLNQ
+9 IF SDAMTYP'="C"
DO CHGCAP^VALM("NAME","Patient")
SET SDAMTYP="C"
+10 NEW SDRES
IF SDAMTYP="C"
SET SDRES=$$CLNCK^SDUTL2(+Y,1)
IF 'SDRES
Begin DoDot:1
+11 WRITE !,?5,"Clinic MUST be corrected before continuing."
DO PAUSE^VALM1
End DoDot:1
GOTO CLNQ
+12 SET SDCLN=+Y
KILL SDFN
DO BLD
CLNQ QUIT
+1 ;
