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