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

SDCO7.m

Go to the documentation of this file.
  1. SDCO7 ;ALB/RMO - Miscellaneous Actions - Check Out; 14 APR 1993 10:00 am
  1. ;;5.3;Scheduling;**132,149,175,193**;Aug 13, 1993
  1. ;
  1. CD ;Entry point for SDCO DATE CHANGE protocol
  1. ; Input -- SDOE
  1. N DFN,SDCL,SDCOQUIT,SDDA,SDOE0,SDORG,SDT
  1. S VALMBCK=""
  1. ;
  1. ; -- if OLD encounter, quit
  1. IF '$$EDITOK^SDCO3($G(SDOE),1) G CDQ
  1. ;
  1. S SDOE0=$G(^SCE(+SDOE,0)),SDT=+^(0),DFN=+$P(SDOE0,"^",2),SDCL=+$P(SDOE0,"^",4),SDORG=+$P(SDOE0,"^",8),SDDA=+$P(SDOE0,"^",9)
  1. I SDORG'=1 W !!,*7,">>> Only appointments have a check out date to edit." D PAUSE^VALM1 G CDQ
  1. I '$P($G(^SC(SDCL,"S",SDT,1,SDDA,"C")),"^",3) W !!,*7,">>> No check out date for this appointment." D PAUSE^VALM1 G CDQ
  1. D DT^SDCO1(DFN,SDT,SDCL,SDDA,1,.SDCOQUIT)
  1. S VALMBCK="R"
  1. CDQ Q
  1. ;
  1. PD ;Entry point for SDCO PATIENT DEMOGRAPHICS protocol
  1. ; Input -- SDOE
  1. S VALMBCK=""
  1. D FULL^VALM1
  1. W !!,VALMHDR(1),!
  1. D DEM^SDCOAM(+$P($G(^SCE(+SDOE,0)),"^",2))
  1. S VALMBCK="R"
  1. PDQ Q
  1. ;
  1. DC ;Entry point for SDCO DISCHARGE CLINIC protocol
  1. ; Input -- SDOE
  1. N DFN,SDCLN,SDFN,SDOE0
  1. S VALMBCK=""
  1. S SDOE0=$G(^SCE(+SDOE,0)),SDFN=+$P(SDOE0,"^",2)
  1. S:$P(SDOE0,"^",4) SDCLN=+$P(SDOE0,"^",4)
  1. D FULL^VALM1
  1. W !!,VALMHDR(1),!
  1. D DIS^SDCOAM(SDFN,$G(SDCLN))
  1. S VALMBCK="R"
  1. DCQ Q
  1. ;
  1. GAF ;Entry point for SDCO GAF protocol
  1. ;Input -- SDOE
  1. S VALMBCK=""
  1. D FULL^VALM1
  1. W !!
  1. N DFN,SDCL,SDELIG
  1. S DFN=+$P($G(^SCE(+SDOE,0)),"^",2)
  1. S SDCL=+$P($G(^SCE(+SDOE,0)),"^",4)
  1. S SDATA=$G(^DPT(DFN,"S",SDT,0))
  1. S SDELIG=$$ELSTAT^SDUTL2(DFN)
  1. ;
  1. I '$$MHCLIN^SDUTL2(SDCL)!($$COLLAT^SDUTL2(SDELIG))!($P(SDATA,U,11)) D S VALMBCK="R" Q
  1. . S DIR(0)="FAO"
  1. . S DIR("A",1)="A GAF Score is not applicable to this appointment!"
  1. . S DIR("A")="Press any key to continue"
  1. . D ^DIR K DIR
  1. ;
  1. N SDGSCR S SDGSCR=$$NEWGAF^SDUTL2(DFN)
  1. I +$P(SDGSCR,U,5)>0 W !,"Warning: Patient is deceased."
  1. I '+SDGSCR D
  1. . W !,"Current GAF: "_+$P(SDGSCR,U,2)
  1. . W $S($P(SDGSCR,U,3)>0:", from "_$$FMTE^XLFDT($P(SDGSCR,U,3),"D"),1:", Date Unavailable")
  1. ;
  1. D EN^SDGAF(DFN)
  1. D HDR^SDCO ; reset header after entering new GAF score
  1. S VALMBCK="R"
  1. GAFQ Q