BSDAMEP.m

BSDAMEP ; IHS/ANMC/LJF - Extended Display; 

 ;;5.3;PIMS;**1012**;APR 26, 2002

 ;

EN ;EP; Selection of appointment

 ; requires DFN, SDT, SDCL, and SDW be set

 K ^TMP("SDAMEP",$J)

 S VALMBCK=""

 N SDWIDTH,SDPT,SDSC

 W ! D WAIT^DICD,EN^VALM("BSDAM APPT PROFILE")

 S VALMBCK="R"

ENQ Q

 ;

HDR ; Header

 N VA,VAERR

 ;S VALMHDR(1)=$$SP^BDGF(15)_$$CONF^BDGF  cmi/maw 5/14/2010 PATCH 1012 RQMT148 orig line

 S VALMHDR(1)=$S($$GET1^DIQ(44,SDCL,3.5)]"":$$GET1^DIQ(44,SDCL,3.5),$$GET1^DIQ(44,SDCL,3)]"":$$GET1^DIQ(44,SDCL,3),1:"")_$$SP^BDGF(5)_$$CONF^BDGF  ;cmi/maw 5/14/2010 PATCH 1012 RQMT148 mod line

 D PID^VADPT

 S VALMHDR(2)=$E($P("Patient: "_$G(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("BID")_")"_" Phone: "_$$GET1^DIQ(2,DFN,.131)

 I $$DEAD^BDGF2(DFN) S X=$G(IORVON)_"Died on "_$$DOD^BDGF2(DFN)_$G(IORVOFF),VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),40,60)

 S X=$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")

 S VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),81-$L(X),$L(X))

 S X="Clinic: "_$P(^SC(SDCL,0),U)

 S VALMHDR(3)=$$SETSTR^VALM1(X,"Appointment #: "_SDW,81-$L(X),$L(X))

 Q

 ;

INIT ;

 N VA,VAERR,SDFSTCOL,SDSECCOL,CTRLCOL

 D PID^VADPT

 S SDDA=$$SCIEN^BSDU2(DFN,SDCL,SDT),SDLN=0

 D INIT^SDAMEP1

 D APDATA^SDAMEP1 ;        Appointment Data

 D APLOG^SDAMEP3 ;         Appointment Event Log

 S VALMCNT=SDLN

 Q

 ;

EXIT ;EP;

 K ^TMP("SDAMEP",$J)

 K VALMCNT,SDT,SDCL,SDDA,SDLN,DFN,SDW,SDOE,SDPOV,SDPV

 Q

 ;

VISIT ; -- set up IHS visit display lines

 ; Appointment Check Out Data

 ;

 D SET^SDAMEP1($$SETSTR^VALM1("*** Check Out ***","",24,17))

 D CNTRL^VALM10(SDLN,24,17,IOINHI,IOINORM)

 D SET^SDAMEP1("")

 ;

 I '$$CODT^SDCOU(DFN,SDT,SDCL) D  G APCOQ

 .D SET^SDAMEP1($$SETSTR^VALM1("No check out information.","",2,25))

 D EN^SDCO0("SDAMEP",SDOE,SDLN,.SDLN)

APCOQ Q

BSDAMEP   ; IHS/ANMC/LJF - Extended Display; 

 +1       ;;5.3;PIMS;**1012**;APR 26, 2002

 +2       ;

EN        ;EP; Selection of appointment

 +1       ; requires DFN, SDT, SDCL, and SDW be set

 +2        KILL ^TMP("SDAMEP",$JOB)

 +3        SET VALMBCK=""

 +4        NEW SDWIDTH,SDPT,SDSC

 +5        WRITE !

           DO WAIT^DICD

           DO EN^VALM("BSDAM APPT PROFILE")

 +6        SET VALMBCK="R"

ENQ        QUIT 

 +1       ;

HDR       ; Header

 +1        NEW VA,VAERR

 +2       ;S VALMHDR(1)=$$SP^BDGF(15)_$$CONF^BDGF  cmi/maw 5/14/2010 PATCH 1012 RQMT148 orig line

 +3       ;cmi/maw 5/14/2010 PATCH 1012 RQMT148 mod line

           SET VALMHDR(1)=$SELECT($$GET1^DIQ(44,SDCL,3.5)]"":$$GET1^DIQ(44,SDCL,3.5),$$GET1^DIQ(44,SDCL,3)]"":$$GET1^DIQ(44,SDCL,3),1:"")_$$SP^BDGF(5)_$$CONF^BDGF

 +4        DO PID^VADPT

 +5        SET VALMHDR(2)=$EXTRACT($PIECE("Patient: "_$GET(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("BID")_")"_" Phone: "_$$GET1^DIQ(2,DFN,.131)

 +6        IF $$DEAD^BDGF2(DFN)

               SET X=$GET(IORVON)_"Died on "_$$DOD^BDGF2(DFN)_$GET(IORVOFF)

               SET VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),40,60)

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

 +8        SET VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),81-$LENGTH(X),$LENGTH(X))

 +9        SET X="Clinic: "_$PIECE(^SC(SDCL,0),U)

 +10       SET VALMHDR(3)=$$SETSTR^VALM1(X,"Appointment #: "_SDW,81-$LENGTH(X),$LENGTH(X))

 +11       QUIT 

 +12      ;

INIT      ;

 +1        NEW VA,VAERR,SDFSTCOL,SDSECCOL,CTRLCOL

 +2        DO PID^VADPT

 +3        SET SDDA=$$SCIEN^BSDU2(DFN,SDCL,SDT)

           SET SDLN=0

 +4        DO INIT^SDAMEP1

 +5       ;        Appointment Data

           DO APDATA^SDAMEP1

 +6       ;         Appointment Event Log

           DO APLOG^SDAMEP3

 +7        SET VALMCNT=SDLN

 +8        QUIT 

 +9       ;

EXIT      ;EP;

 +1        KILL ^TMP("SDAMEP",$JOB)

 +2        KILL VALMCNT,SDT,SDCL,SDDA,SDLN,DFN,SDW,SDOE,SDPOV,SDPV

 +3        QUIT 

 +4       ;

VISIT     ; -- set up IHS visit display lines

 +1       ; Appointment Check Out Data

 +2       ;

 +3        DO SET^SDAMEP1($$SETSTR^VALM1("*** Check Out ***","",24,17))

 +4        DO CNTRL^VALM10(SDLN,24,17,IOINHI,IOINORM)

 +5        DO SET^SDAMEP1("")

 +6       ;

 +7        IF '$$CODT^SDCOU(DFN,SDT,SDCL)

               Begin DoDot:1

 +8                DO SET^SDAMEP1($$SETSTR^VALM1("No check out information.","",2,25))

               End DoDot:1

               GOTO APCOQ

 +9        DO EN^SDCO0("SDAMEP",SDOE,SDLN,.SDLN)

APCOQ      QUIT