SDAM10.m

SDAM10 ;MJK/ALB - Appt Mgt (Patient cont.); 3/18/05 3:51pm  ; Compiled March 31, 2008 16:38:47

 ;;5.3;Scheduling;**189,258,403,478,491,1004,1015**;Aug 13, 1993;Build 21

 ;IHS/ANMC/LJF 10/10/2001 moved mods to BSDAM10

 ;IHS/OIT/LJF  07/28/2005 PATCH 1004 added code to display waiting list info

 ;

HDR ; -- list screen header

 ;   input:       SDFN := ifn of pat

 ;  output:  VALMHDR() := hdr array

 D HDR^BSDAM10 Q      ;IHS/ANMC/LJF 10/10/2001

 ;

 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)

 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

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

 ;IHS/OIT/LJF 7/28/2005 PATCH 1004

 ;I '$O(^TMP("SDAM",$J,0)) D SET^SDAM1(" "),SET^SDAM1("    No appointments meet criteria.")

 I '$O(^TMP("SDAM",$J,0)) D

 . D SET^SDAM1(" "),SET^SDAM1("    No appointments meet criteria.")

 . I SDAMTYP="P" D WLDIS^BSDAM(DFN)

 Q

 ;

SDAM10    ;MJK/ALB - Appt Mgt (Patient cont.); 3/18/05 3:51pm  ; Compiled March 31, 2008 16:38:47

 +1       ;;5.3;Scheduling;**189,258,403,478,491,1004,1015**;Aug 13, 1993;Build 21

 +2       ;IHS/ANMC/LJF 10/10/2001 moved mods to BSDAM10

 +3       ;IHS/OIT/LJF  07/28/2005 PATCH 1004 added code to display waiting list info

 +4       ;

HDR       ; -- list screen header

 +1       ;   input:       SDFN := ifn of pat

 +2       ;  output:  VALMHDR() := hdr array

 +3       ;IHS/ANMC/LJF 10/10/2001

           DO HDR^BSDAM10

           QUIT 

 +4       ;

 +5        NEW VAERR,VA,X

 +6        SET DFN=SDFN

           DO PID^VADPT

 +7       ;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")_")"

 +8        SET X=$PIECE($$FMT^SDUTL2(SDFN),U,2)

           SET X=$SELECT(X["GMT":X,X]"":"MT: "_X,1:"")

 +9       ;repositioned header to display clinic or patient name properly for SD*5.3*189

           SET VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),47,15)

 +10       SET X=$SELECT($DATA(^DPT(SDFN,.1)):"Ward: "_^(.1),1:"Outpatient")

 +11       SET VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),81-$LENGTH(X),$LENGTH(X))

 +12       QUIT 

 +13      ;

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        IF $DATA(X)

               IF X=""

                   READ !!,"Select Patient: ",X:DTIME

 +5        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       ;SD/491

           SET (DFN,SDFN)=+Y

           KILL SDCLN,VADM

           DO DEM^VADPT

           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       ;IHS/OIT/LJF 7/28/2005 PATCH 1004

 +2       ;I '$O(^TMP("SDAM",$J,0)) D SET^SDAM1(" "),SET^SDAM1("    No appointments meet criteria.")

 +3        IF '$ORDER(^TMP("SDAM",$JOB,0))

               Begin DoDot:1

 +4                DO SET^SDAM1(" ")

                   DO SET^SDAM1("    No appointments meet criteria.")

 +5                IF SDAMTYP="P"

                       DO WLDIS^BSDAM(DFN)

               End DoDot:1

 +6        QUIT 

 +7       ;