Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BSDAMEPW

BSDAMEPW.m

Go to the documentation of this file. 
  1. BSDAMEPW ; IHS/ANMC/LJF - Extended Display for Wait List Appointments; 
  1.  ;;5.3;PIMS;**1012**;APR 26, 2002
  1.  ;
  1. EN(SDWE) ;EP; Selection of appointment
  1.  ; requires DFN
  1.  K ^TMP("SDAMEPW",$J)
  1.  S VALMBCK=""
  1.  N SDWIDTH,SDPT,SDSC,SDIENSA,SDIENSB
  1.  S SDIENSA=$P(SDWE,",",2)
  1.  S SDIENSB=$P(SDWE,",")
  1.  S SDCL=$$GET1^DIQ(9009017.1,SDIENSA,.01,"I")
  1.  W ! D WAIT^DICD,EN^VALM("BSDAM WAIT LIST PROFILE")
  1.  S VALMBCK="R"
  1. ENQ Q
  1.  ;
  1. HDR ; Header
  1.  N VA,VAERR
  1.  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
  1.  D PID^VADPT
  1.  S VALMHDR(2)=$E($P("Patient: "_$G(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("BID")_")"_" Phone: "_$$GET1^DIQ(2,DFN,.131)
  1.  I $$DEAD^BDGF2(DFN) S X=$G(IORVON)_"Died on "_$$DOD^BDGF2(DFN)_$G(IORVOFF),VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),40,60)
  1.  S X=$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
  1.  S VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),81-$L(X),$L(X))
  1.  S X="Clinic: "_$P(^SC(SDCL,0),U)
  1.  Q
  1.  ;
  1. INIT ;
  1.  N VA,VAERR,SDFSTCOL,SDSECCOL,CTRLCOL
  1.  D PID^VADPT
  1.  S SDFSTCOL=18,SDWIDTH=16,SDSECCOL=57
  1.  D VARS
  1.  D WLDATA ;        Appointment Data
  1.  S VALMCNT=SDLN
  1.  Q
  1.  ;
  1. VARS ;-- get vars for the expanded profile
  1.  S SDPRI=$$GET1^DIQ(9009017.11,SDWE,.02)
  1.  S SDADD=$$GET1^DIQ(9009017.11,SDWE,.03)
  1.  S SDUSERA=$$GET1^DIQ(9009017.11,SDWE,.04)
  1.  S SDREC=$$GET1^DIQ(9009017.11,SDWE,.05)
  1.  S SDREM=$$GET1^DIQ(9009017.11,SDWE,.07)
  1.  S SDUSERR=$$GET1^DIQ(9009017.11,SDWE,.11)
  1.  S SDREA=$$GET1^DIQ(9009017.11,SDWE,.09)
  1.  S SDPRV=$$GET1^DIQ(9009017.11,SDWE,.06)
  1.  S SDRES=$$GET1^DIQ(9009017.11,SDWE,.08)
  1.  Q
  1.  ;
  1. WLDATA ; Appointment Data
  1.  ;
  1.  D SET($$SETSTR^VALM1("*** Wait List Demographics ***","",24,32))
  1.  D CNTRL^VALM10(SDLN,24,32,IOINHI,IOINORM)
  1.  D SET("")
  1.  ;
  1.  S X=""
  1.  S X=$$SETSTR^VALM1("           Name:",X,1,SDWIDTH)
  1.  S X=$$SETSTR^VALM1($P($G(^DPT(DFN,0)),U),X,SDFSTCOL,24)
  1.  S X=$$SETSTR^VALM1("         Clinic:",X,40,SDWIDTH)
  1.  S X=$$SETSTR^VALM1($P($G(^SC(SDCL,0)),U),X,SDSECCOL,24)
  1.  D SET(X)
  1.  ;
  1.  S X=""
  1.  S X=$$SETSTR^VALM1("       Priority:",X,1,SDWIDTH)
  1.  S X=$$SETSTR^VALM1(SDPRI,X,SDFSTCOL,24)
  1.  S X=$$SETSTR^VALM1("   Reason Added:",X,40,SDWIDTH)
  1.  S X=$$SETSTR^VALM1(SDREA,X,SDSECCOL,24)
  1.  D SET(X)
  1.  ;
  1.  S X=""
  1.  S X=$$SETSTR^VALM1("     Date Added:",X,1,SDWIDTH)
  1.  S X=$$SETSTR^VALM1(SDADD,X,SDFSTCOL,24)
  1.  S X=$$SETSTR^VALM1(" User Who Added:",X,40,SDWIDTH)
  1.  S X=$$SETSTR^VALM1(SDUSERA,X,SDSECCOL,50)
  1.  D SET(X)
  1.  ;
  1.  S X=""
  1.  S X=$$SETSTR^VALM1("       Provider:",X,1,SDWIDTH)
  1.  S X=$$SETSTR^VALM1(SDPRV,X,SDFSTCOL,24)
  1.  S X=$$SETSTR^VALM1("    Recall Date:",X,40,SDWIDTH)
  1.  S X=$$SETSTR^VALM1(SDREC,X,SDSECCOL,50)
  1.  D SET(X)
  1.  ;
  1.  S X=""
  1.  S X=$$SETSTR^VALM1("   Date Removed:",X,1,SDWIDTH)
  1.  S X=$$SETSTR^VALM1(SDREM,X,SDFSTCOL,24)
  1.  S X=$$SETSTR^VALM1("User Who Remove:",X,40,SDWIDTH)
  1.  S X=$$SETSTR^VALM1(SDUSERR,X,SDSECCOL,50)
  1.  D SET(X)
  1.  ;
  1.  S X=""
  1.  S X=$$SETSTR^VALM1("     Resolution:",X,1,SDWIDTH)
  1.  S X=$$SETSTR^VALM1(SDRES,X,SDFSTCOL,24)
  1.  D SET(X)
  1.  ;
  1.  S X=""
  1.  S X=$$SETSTR^VALM1("       Comments:",X,1,SDWIDTH)
  1.  D SET(X)
  1.  N BSDA,BSDCMT,BSDCMTC
  1.  S BSDCMTC=0,BSDCMT=""
  1.  S BSDA=0 F  S BSDA=$O(^BSDWL(SDIENSA,1,SDIENSB,1,BSDA)) Q:'BSDA  D
  1.  . S BSDCMTC=BSDCMTC+1
  1.  . S BSDCMT=BSDCMT_$G(^BSDWL(SDIENSA,1,SDIENSB,1,BSDA,0))
  1.  D WRAP^BDGF(BSDCMT,60,.BSDCMT)
  1.  I $D(BSDCMT(1)) D
  1.  . S X="",X=$$SETSTR^VALM1(BSDCMT(1),X,SDFSTCOL,60) D SET(X)   ;first line as before
  1.  . F I=2:1 Q:'$D(BSDCMT(I))  S X=$$REPEAT^XLFSTR(" ",SDWIDTH),X=$$SETSTR^VALM1(BSDCMT(I),X,SDFSTCOL,60) D SET(X)
  1.  ;
  1.  D SET(""),SET("")
  1.  Q
  1.  ;
  1. SET(X) ; Set in ^TMP global for display
  1.  S SDLN=SDLN+1,^TMP("SDAMEPW",$J,SDLN,0)=X
  1.  Q
  1.  ;
  1. EXIT ;EP;
  1.  K ^TMP("SDAMEPW",$J)
  1.  K VALMCNT,SDT,SDCL,SDDA,SDLN,DFN,SDW,SDOE,SDPOV,SDPV
  1.  K SDPRI,SDADD,SDUSERA,SDREM,SDUSERR,SDREA,SDPRV,SDRES,SDCMT
  1.  Q
  1.  ;
  1. VISIT ; -- set up IHS visit display lines
  1.  ; Appointment Check Out Data
  1.  ;
  1.  D SET^SDAMEP1($$SETSTR^VALM1("*** Check Out ***","",24,17))
  1.  D CNTRL^VALM10(SDLN,24,17,IOINHI,IOINORM)
  1.  D SET^SDAMEP1("")
  1.  ;
  1.  I '$$CODT^SDCOU(DFN,SDT,SDCL) D  G APCOQ
  1.  .D SET^SDAMEP1($$SETSTR^VALM1("No check out information.","",2,25))
  1.  D EN^SDCO0("SDAMEP",SDOE,SDLN,.SDLN)
  1. APCOQ Q