BSDAMEPW ; IHS/ANMC/LJF - Extended Display for Wait List Appointments;
;;5.3;PIMS;**1012**;APR 26, 2002
;
EN(SDWE) ;EP; Selection of appointment
; requires DFN
K ^TMP("SDAMEPW",$J)
S VALMBCK=""
N SDWIDTH,SDPT,SDSC,SDIENSA,SDIENSB
S SDIENSA=$P(SDWE,",",2)
S SDIENSB=$P(SDWE,",")
S SDCL=$$GET1^DIQ(9009017.1,SDIENSA,.01,"I")
W ! D WAIT^DICD,EN^VALM("BSDAM WAIT LIST PROFILE")
S VALMBCK="R"
ENQ Q
;
HDR ; Header
N VA,VAERR
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)
Q
;
INIT ;
N VA,VAERR,SDFSTCOL,SDSECCOL,CTRLCOL
D PID^VADPT
S SDFSTCOL=18,SDWIDTH=16,SDSECCOL=57
D VARS
D WLDATA ; Appointment Data
S VALMCNT=SDLN
Q
;
VARS ;-- get vars for the expanded profile
S SDPRI=$$GET1^DIQ(9009017.11,SDWE,.02)
S SDADD=$$GET1^DIQ(9009017.11,SDWE,.03)
S SDUSERA=$$GET1^DIQ(9009017.11,SDWE,.04)
S SDREC=$$GET1^DIQ(9009017.11,SDWE,.05)
S SDREM=$$GET1^DIQ(9009017.11,SDWE,.07)
S SDUSERR=$$GET1^DIQ(9009017.11,SDWE,.11)
S SDREA=$$GET1^DIQ(9009017.11,SDWE,.09)
S SDPRV=$$GET1^DIQ(9009017.11,SDWE,.06)
S SDRES=$$GET1^DIQ(9009017.11,SDWE,.08)
Q
;
WLDATA ; Appointment Data
;
D SET($$SETSTR^VALM1("*** Wait List Demographics ***","",24,32))
D CNTRL^VALM10(SDLN,24,32,IOINHI,IOINORM)
D SET("")
;
S X=""
S X=$$SETSTR^VALM1(" Name:",X,1,SDWIDTH)
S X=$$SETSTR^VALM1($P($G(^DPT(DFN,0)),U),X,SDFSTCOL,24)
S X=$$SETSTR^VALM1(" Clinic:",X,40,SDWIDTH)
S X=$$SETSTR^VALM1($P($G(^SC(SDCL,0)),U),X,SDSECCOL,24)
D SET(X)
;
S X=""
S X=$$SETSTR^VALM1(" Priority:",X,1,SDWIDTH)
S X=$$SETSTR^VALM1(SDPRI,X,SDFSTCOL,24)
S X=$$SETSTR^VALM1(" Reason Added:",X,40,SDWIDTH)
S X=$$SETSTR^VALM1(SDREA,X,SDSECCOL,24)
D SET(X)
;
S X=""
S X=$$SETSTR^VALM1(" Date Added:",X,1,SDWIDTH)
S X=$$SETSTR^VALM1(SDADD,X,SDFSTCOL,24)
S X=$$SETSTR^VALM1(" User Who Added:",X,40,SDWIDTH)
S X=$$SETSTR^VALM1(SDUSERA,X,SDSECCOL,50)
D SET(X)
;
S X=""
S X=$$SETSTR^VALM1(" Provider:",X,1,SDWIDTH)
S X=$$SETSTR^VALM1(SDPRV,X,SDFSTCOL,24)
S X=$$SETSTR^VALM1(" Recall Date:",X,40,SDWIDTH)
S X=$$SETSTR^VALM1(SDREC,X,SDSECCOL,50)
D SET(X)
;
S X=""
S X=$$SETSTR^VALM1(" Date Removed:",X,1,SDWIDTH)
S X=$$SETSTR^VALM1(SDREM,X,SDFSTCOL,24)
S X=$$SETSTR^VALM1("User Who Remove:",X,40,SDWIDTH)
S X=$$SETSTR^VALM1(SDUSERR,X,SDSECCOL,50)
D SET(X)
;
S X=""
S X=$$SETSTR^VALM1(" Resolution:",X,1,SDWIDTH)
S X=$$SETSTR^VALM1(SDRES,X,SDFSTCOL,24)
D SET(X)
;
S X=""
S X=$$SETSTR^VALM1(" Comments:",X,1,SDWIDTH)
D SET(X)
N BSDA,BSDCMT,BSDCMTC
S BSDCMTC=0,BSDCMT=""
S BSDA=0 F S BSDA=$O(^BSDWL(SDIENSA,1,SDIENSB,1,BSDA)) Q:'BSDA D
. S BSDCMTC=BSDCMTC+1
. S BSDCMT=BSDCMT_$G(^BSDWL(SDIENSA,1,SDIENSB,1,BSDA,0))
D WRAP^BDGF(BSDCMT,60,.BSDCMT)
I $D(BSDCMT(1)) D
. S X="",X=$$SETSTR^VALM1(BSDCMT(1),X,SDFSTCOL,60) D SET(X) ;first line as before
. F I=2:1 Q:'$D(BSDCMT(I)) S X=$$REPEAT^XLFSTR(" ",SDWIDTH),X=$$SETSTR^VALM1(BSDCMT(I),X,SDFSTCOL,60) D SET(X)
;
D SET(""),SET("")
Q
;
SET(X) ; Set in ^TMP global for display
S SDLN=SDLN+1,^TMP("SDAMEPW",$J,SDLN,0)=X
Q
;
EXIT ;EP;
K ^TMP("SDAMEPW",$J)
K VALMCNT,SDT,SDCL,SDDA,SDLN,DFN,SDW,SDOE,SDPOV,SDPV
K SDPRI,SDADD,SDUSERA,SDREM,SDUSERR,SDREA,SDPRV,SDRES,SDCMT
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
BSDAMEPW ; IHS/ANMC/LJF - Extended Display for Wait List Appointments;
+1 ;;5.3;PIMS;**1012**;APR 26, 2002
+2 ;
EN(SDWE) ;EP; Selection of appointment
+1 ; requires DFN
+2 KILL ^TMP("SDAMEPW",$JOB)
+3 SET VALMBCK=""
+4 NEW SDWIDTH,SDPT,SDSC,SDIENSA,SDIENSB
+5 SET SDIENSA=$PIECE(SDWE,",",2)
+6 SET SDIENSB=$PIECE(SDWE,",")
+7 SET SDCL=$$GET1^DIQ(9009017.1,SDIENSA,.01,"I")
+8 WRITE !
DO WAIT^DICD
DO EN^VALM("BSDAM WAIT LIST PROFILE")
+9 SET VALMBCK="R"
ENQ QUIT
+1 ;
HDR ; Header
+1 NEW VA,VAERR
+2 ;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
+3 DO PID^VADPT
+4 SET VALMHDR(2)=$EXTRACT($PIECE("Patient: "_$GET(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("BID")_")"_" Phone: "_$$GET1^DIQ(2,DFN,.131)
+5 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)
+6 SET X=$SELECT($DATA(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
+7 SET VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),81-$LENGTH(X),$LENGTH(X))
+8 SET X="Clinic: "_$PIECE(^SC(SDCL,0),U)
+9 QUIT
+10 ;
INIT ;
+1 NEW VA,VAERR,SDFSTCOL,SDSECCOL,CTRLCOL
+2 DO PID^VADPT
+3 SET SDFSTCOL=18
SET SDWIDTH=16
SET SDSECCOL=57
+4 DO VARS
+5 ; Appointment Data
DO WLDATA
+6 SET VALMCNT=SDLN
+7 QUIT
+8 ;
VARS ;-- get vars for the expanded profile
+1 SET SDPRI=$$GET1^DIQ(9009017.11,SDWE,.02)
+2 SET SDADD=$$GET1^DIQ(9009017.11,SDWE,.03)
+3 SET SDUSERA=$$GET1^DIQ(9009017.11,SDWE,.04)
+4 SET SDREC=$$GET1^DIQ(9009017.11,SDWE,.05)
+5 SET SDREM=$$GET1^DIQ(9009017.11,SDWE,.07)
+6 SET SDUSERR=$$GET1^DIQ(9009017.11,SDWE,.11)
+7 SET SDREA=$$GET1^DIQ(9009017.11,SDWE,.09)
+8 SET SDPRV=$$GET1^DIQ(9009017.11,SDWE,.06)
+9 SET SDRES=$$GET1^DIQ(9009017.11,SDWE,.08)
+10 QUIT
+11 ;
WLDATA ; Appointment Data
+1 ;
+2 DO SET($$SETSTR^VALM1("*** Wait List Demographics ***","",24,32))
+3 DO CNTRL^VALM10(SDLN,24,32,IOINHI,IOINORM)
+4 DO SET("")
+5 ;
+6 SET X=""
+7 SET X=$$SETSTR^VALM1(" Name:",X,1,SDWIDTH)
+8 SET X=$$SETSTR^VALM1($PIECE($GET(^DPT(DFN,0)),U),X,SDFSTCOL,24)
+9 SET X=$$SETSTR^VALM1(" Clinic:",X,40,SDWIDTH)
+10 SET X=$$SETSTR^VALM1($PIECE($GET(^SC(SDCL,0)),U),X,SDSECCOL,24)
+11 DO SET(X)
+12 ;
+13 SET X=""
+14 SET X=$$SETSTR^VALM1(" Priority:",X,1,SDWIDTH)
+15 SET X=$$SETSTR^VALM1(SDPRI,X,SDFSTCOL,24)
+16 SET X=$$SETSTR^VALM1(" Reason Added:",X,40,SDWIDTH)
+17 SET X=$$SETSTR^VALM1(SDREA,X,SDSECCOL,24)
+18 DO SET(X)
+19 ;
+20 SET X=""
+21 SET X=$$SETSTR^VALM1(" Date Added:",X,1,SDWIDTH)
+22 SET X=$$SETSTR^VALM1(SDADD,X,SDFSTCOL,24)
+23 SET X=$$SETSTR^VALM1(" User Who Added:",X,40,SDWIDTH)
+24 SET X=$$SETSTR^VALM1(SDUSERA,X,SDSECCOL,50)
+25 DO SET(X)
+26 ;
+27 SET X=""
+28 SET X=$$SETSTR^VALM1(" Provider:",X,1,SDWIDTH)
+29 SET X=$$SETSTR^VALM1(SDPRV,X,SDFSTCOL,24)
+30 SET X=$$SETSTR^VALM1(" Recall Date:",X,40,SDWIDTH)
+31 SET X=$$SETSTR^VALM1(SDREC,X,SDSECCOL,50)
+32 DO SET(X)
+33 ;
+34 SET X=""
+35 SET X=$$SETSTR^VALM1(" Date Removed:",X,1,SDWIDTH)
+36 SET X=$$SETSTR^VALM1(SDREM,X,SDFSTCOL,24)
+37 SET X=$$SETSTR^VALM1("User Who Remove:",X,40,SDWIDTH)
+38 SET X=$$SETSTR^VALM1(SDUSERR,X,SDSECCOL,50)
+39 DO SET(X)
+40 ;
+41 SET X=""
+42 SET X=$$SETSTR^VALM1(" Resolution:",X,1,SDWIDTH)
+43 SET X=$$SETSTR^VALM1(SDRES,X,SDFSTCOL,24)
+44 DO SET(X)
+45 ;
+46 SET X=""
+47 SET X=$$SETSTR^VALM1(" Comments:",X,1,SDWIDTH)
+48 DO SET(X)
+49 NEW BSDA,BSDCMT,BSDCMTC
+50 SET BSDCMTC=0
SET BSDCMT=""
+51 SET BSDA=0
FOR
SET BSDA=$ORDER(^BSDWL(SDIENSA,1,SDIENSB,1,BSDA))
IF 'BSDA
QUIT
Begin DoDot:1
+52 SET BSDCMTC=BSDCMTC+1
+53 SET BSDCMT=BSDCMT_$GET(^BSDWL(SDIENSA,1,SDIENSB,1,BSDA,0))
End DoDot:1
+54 DO WRAP^BDGF(BSDCMT,60,.BSDCMT)
+55 IF $DATA(BSDCMT(1))
Begin DoDot:1
+56 ;first line as before
SET X=""
SET X=$$SETSTR^VALM1(BSDCMT(1),X,SDFSTCOL,60)
DO SET(X)
+57 FOR I=2:1
IF '$DATA(BSDCMT(I))
QUIT
SET X=$$REPEAT^XLFSTR(" ",SDWIDTH)
SET X=$$SETSTR^VALM1(BSDCMT(I),X,SDFSTCOL,60)
DO SET(X)
End DoDot:1
+58 ;
+59 DO SET("")
DO SET("")
+60 QUIT
+61 ;
SET(X) ; Set in ^TMP global for display
+1 SET SDLN=SDLN+1
SET ^TMP("SDAMEPW",$JOB,SDLN,0)=X
+2 QUIT
+3 ;
EXIT ;EP;
+1 KILL ^TMP("SDAMEPW",$JOB)
+2 KILL VALMCNT,SDT,SDCL,SDDA,SDLN,DFN,SDW,SDOE,SDPOV,SDPV
+3 KILL SDPRI,SDADD,SDUSERA,SDREM,SDUSERR,SDREA,SDPRV,SDRES,SDCMT
+4 QUIT
+5 ;
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
