SDAM10 ;ALB/MJK - Appt Mgt (Patient cont.);3/18/05 3:51pm
;;5.3;Scheduling;**189,258,403,478,491,641**;Aug 13, 1993;Build 4
;
HDR ; -- list screen header
; input: SDFN := ifn of pat
; output: VALMHDR() := hdr array
;
N VAERR,VA,X
S DFN=SDFN D PID^VADPT
S VALMHDR(1)=$E($P("Patient: "_$G(^DPT(SDFN,0)),U),1,46)_" ("_VA("BID")_")" ;for proper display of patient name for SD*5.3*189
S X=$P($$FMT^SDUTL2(SDFN),U,2),X=$S(X["GMT":X,X]"":"MT: "_X,1:"")
S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),47,15) ;repositioned header to display clinic or patient name properly for SD*5.3*189
S X=$S($D(^DPT(SDFN,.1)):"Ward: "_^(.1),1:"Outpatient")
S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),81-$L(X),$L(X))
Q
;
PAT ; -- change pat
K TMP ;SD/478
D FULL^VALM1 S VALMBCK="R"
K X I $D(XQORNOD(0)) S X=$P($P(XQORNOD(0),U,4),"=",2)
N SDUP
I $D(X),X="" R !!,"Select Patient: ",X:DTIME
D RT^SDAMEX S DIC="^DPT(",DIC(0)="EMQ" D ^DIC K DIC G PAT:X["?"
PAT1 S %=1 I Y>0 W !," ...OK" D YN^DICN I %=0 W " Answer with 'Yes' or 'No'" G PAT1
I %'=1 S Y=-1
I Y<0 D G PATQ
.I $G(DFN)>0,SDAMTYP="P" S VALMSG=$C(7)_"Patient has not been changed."
.I $G(DFN)'>0,SDAMTYP="P" S VALMSG=$C(7)_"Patient has not been selected."
.I SDAMTYP="C" S VALMSG=$C(7)_"View of clinic remains in affect."
.W !!,$G(VALMSG) H 1
I SDAMTYP'="P" D CHGCAP^VALM("NAME","Clinic") S SDAMTYP="P"
;S (DFN,SDFN)=+Y K SDCLN,VADM D DEM^VADPT D BLD^SDAM1 ;SD/491
S (DFN,SDFN)=+Y K SDCLN,VADM D DEM^VADPT
I +VADM(6) D G:SDUP="^" PAT ;SD*641 - Display DoD if exists.
. W !!,"WARNING ",VADM(7),!!
. R "Press Return to Continue or ^ to Quit: ",SDUP:DTIME
D BLD^SDAM1
PATQ Q
;
INIT ; -- init bld vars
K VALMHDR,SDDA,^TMP("SDAMIDX",$J)
D CLEAN^VALM10
S VALMBG=1,(VALMCNT,SDACNT)=0,BL="",$P(BL," ",30)="",SDMAX=100
S SDAMDD=$P(^DD(2.98,3,0),U,3)
; -- format vars |- column -| |- width -|
S X=VALMDDF("APPT#"),AC=$P(X,U,2),AW=$P(X,U,3) ; A for appt
S X=VALMDDF("DATE"),XC=$P(X,U,2),XW=$P(X,U,3) ; X for date
S X=VALMDDF("NAME"),NC=$P(X,U,2),NW=$P(X,U,3) ; N for name
S X=VALMDDF("STAT"),SC=$P(X,U,2),SW=$P(X,U,3) ; S for status
S X=VALMDDF("TIME"),TC=$P(X,U,2),TW=$P(X,U,3) ; T for time
S (CC,CW)="",X=$G(VALMDDF("CONSULT")) I X'="" S CC=$P(X,U,2),CW=$P(X,U,3) ; C for Consult ;SD/478
Q
;
LARGE ; -- too large note
W !!?5,*7,"Note: Ending Date was changed to '",$$FDATE^VALM1(SDEND),"' because"
W !?11,"too many appointments met date range criteria." D PAUSE^VALM1
Q
;
NUL ; -- set nul message
I '$O(^TMP("SDAM",$J,0)) D SET^SDAM1(" "),SET^SDAM1(" No appointments meet criteria.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAM10 2651 printed Apr 09, 2024@21:47:30 Page 2
SDAM10 ;ALB/MJK - Appt Mgt (Patient cont.);3/18/05 3:51pm
+1 ;;5.3;Scheduling;**189,258,403,478,491,641**;Aug 13, 1993;Build 4
+2 ;
HDR ; -- list screen header
+1 ; input: SDFN := ifn of pat
+2 ; output: VALMHDR() := hdr array
+3 ;
+4 NEW VAERR,VA,X
+5 SET DFN=SDFN
DO PID^VADPT
+6 ;for proper display of patient name for SD*5.3*189
SET VALMHDR(1)=$EXTRACT($PIECE("Patient: "_$GET(^DPT(SDFN,0)),U),1,46)_" ("_VA("BID")_")"
+7 SET X=$PIECE($$FMT^SDUTL2(SDFN),U,2)
SET X=$SELECT(X["GMT":X,X]"":"MT: "_X,1:"")
+8 ;repositioned header to display clinic or patient name properly for SD*5.3*189
SET VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),47,15)
+9 SET X=$SELECT($DATA(^DPT(SDFN,.1)):"Ward: "_^(.1),1:"Outpatient")
+10 SET VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),81-$LENGTH(X),$LENGTH(X))
+11 QUIT
+12 ;
PAT ; -- change pat
+1 ;SD/478
KILL TMP
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 KILL X
IF $DATA(XQORNOD(0))
SET X=$PIECE($PIECE(XQORNOD(0),U,4),"=",2)
+4 NEW SDUP
+5 IF $DATA(X)
IF X=""
READ !!,"Select Patient: ",X:DTIME
+6 DO RT^SDAMEX
SET DIC="^DPT("
SET DIC(0)="EMQ"
DO ^DIC
KILL DIC
if X["?"
GOTO PAT
PAT1 SET %=1
IF Y>0
WRITE !," ...OK"
DO YN^DICN
IF %=0
WRITE " Answer with 'Yes' or 'No'"
GOTO PAT1
+1 IF %'=1
SET Y=-1
+2 IF Y<0
Begin DoDot:1
+3 IF $GET(DFN)>0
IF SDAMTYP="P"
SET VALMSG=$CHAR(7)_"Patient has not been changed."
+4 IF $GET(DFN)'>0
IF SDAMTYP="P"
SET VALMSG=$CHAR(7)_"Patient has not been selected."
+5 IF SDAMTYP="C"
SET VALMSG=$CHAR(7)_"View of clinic remains in affect."
+6 WRITE !!,$GET(VALMSG)
HANG 1
End DoDot:1
GOTO PATQ
+7 IF SDAMTYP'="P"
DO CHGCAP^VALM("NAME","Clinic")
SET SDAMTYP="P"
+8 ;S (DFN,SDFN)=+Y K SDCLN,VADM D DEM^VADPT D BLD^SDAM1 ;SD/491
+9 SET (DFN,SDFN)=+Y
KILL SDCLN,VADM
DO DEM^VADPT
+10 ;SD*641 - Display DoD if exists.
IF +VADM(6)
Begin DoDot:1
+11 WRITE !!,"WARNING ",VADM(7),!!
+12 READ "Press Return to Continue or ^ to Quit: ",SDUP:DTIME
End DoDot:1
if SDUP="^"
GOTO PAT
+13 DO BLD^SDAM1
PATQ QUIT
+1 ;
INIT ; -- init bld vars
+1 KILL VALMHDR,SDDA,^TMP("SDAMIDX",$JOB)
+2 DO CLEAN^VALM10
+3 SET VALMBG=1
SET (VALMCNT,SDACNT)=0
SET BL=""
SET $PIECE(BL," ",30)=""
SET SDMAX=100
+4 SET SDAMDD=$PIECE(^DD(2.98,3,0),U,3)
+5 ; -- format vars |- column -| |- width -|
+6 ; A for appt
SET X=VALMDDF("APPT#")
SET AC=$PIECE(X,U,2)
SET AW=$PIECE(X,U,3)
+7 ; X for date
SET X=VALMDDF("DATE")
SET XC=$PIECE(X,U,2)
SET XW=$PIECE(X,U,3)
+8 ; N for name
SET X=VALMDDF("NAME")
SET NC=$PIECE(X,U,2)
SET NW=$PIECE(X,U,3)
+9 ; S for status
SET X=VALMDDF("STAT")
SET SC=$PIECE(X,U,2)
SET SW=$PIECE(X,U,3)
+10 ; T for time
SET X=VALMDDF("TIME")
SET TC=$PIECE(X,U,2)
SET TW=$PIECE(X,U,3)
+11 ; C for Consult ;SD/478
SET (CC,CW)=""
SET X=$GET(VALMDDF("CONSULT"))
IF X'=""
SET CC=$PIECE(X,U,2)
SET CW=$PIECE(X,U,3)
+12 QUIT
+13 ;
LARGE ; -- too large note
+1 WRITE !!?5,*7,"Note: Ending Date was changed to '",$$FDATE^VALM1(SDEND),"' because"
+2 WRITE !?11,"too many appointments met date range criteria."
DO PAUSE^VALM1
+3 QUIT
+4 ;
NUL ; -- set nul message
+1 IF '$ORDER(^TMP("SDAM",$JOB,0))
DO SET^SDAM1(" ")
DO SET^SDAM1(" No appointments meet criteria.")
+2 QUIT
+3 ;
