SDAMN ;ALB/MJK - No-Show Appt Action ; 2/4/92
;;5.3;Scheduling;**478,1012,1015**;Aug 13, 1993;Build 21
;IHS/ANMC/LJF 11/09/2000 added extra check before changing checked in
; appt to no-show
;
;cmi/flag/maw 06/02/2010 PATCH 1012 RQMT149 added for list view
;
EN ; -- protocol SDAM APPT NO-SHOW entry pt
; input: VALMY := array entries
;
N VALMY,SDI,SDAT,SDTIME,SDNSACT,DFN,SDCL,SDT,SDSTB,SDSTA,SDSTOP
S VALMBCK="",(SDNSACT,SDSTOP)=0
D SEL^VALM2 G ENQ:'$O(VALMY(0))
D FULL^VALM1 S VALMBCK="R",SDI=0
F S SDI=$O(VALMY(SDI)) Q:'SDI I $D(^TMP("SDAMIDX",$J,SDI)) K SDAT S SDAT=^(SDI) D Q:SDSTOP
.I $P(SDAT,U,6)]"" W !!,*7,">>> This is not a valid appointment." D PAUSE^VALM1 S SDSTOP=1 Q ;cmi/maw 6/2/2010 PATCH 1012 for list view
.D NOW^%DTC S SDTIME=%
.W !,^TMP("SDAM",$J,+SDAT,0),!
.S DFN=+$P(SDAT,U,2),SDT=+$P(SDAT,U,3),SDCL=+$P(SDAT,U,4)
.S SDSTB=$$STATUS^SDAM1(DFN,SDT,SDCL,$G(^DPT(DFN,"S",SDT,0))) ; before status
.Q:'$$CHK
.I $P(SDSTB,";",3)["CHECKED" Q:$$READ^BDGF("YO","Already Checked In. Sure you want to enter No-Show","NO")'=1 ;IHS/ANMC/LJF 11/09/2000
.S SDSTOP=$$NS(DFN,SDT,SDCL,SDTIME,.SDNSACT)
.S SDSTA=$$STATUS^SDAM1(DFN,SDT,SDCL,$G(^DPT(DFN,"S",SDT,0))) ; after status
.I 'SDNSACT,'$$UPD(SDSTB,SDSTA,SDAT,$G(CNSTLNK)) S SDNSACT=2
; values for SDNSACT : 0 = no re-build
; 1 = re-build because of re-book
; 2 = re-build because after not for list
I SDNSACT,SDAMTYP="P" D BLD^SDAM1
I SDNSACT,SDAMTYP="C" D BLD^SDAM3
ENQ Q
;
NS(DFN,SDT,SC,SDTIME,SDNSACT) ; execute no-show code
; input: DFN := pt file ifn
; SDT := d/t of appt
; SC := clinic ifn
; SDTIME := now
; SDNSACT := ns processing flag
; [return] := did user uparrow [ 0|no , 1|yes]
;
N SDI,SDCP,SDYES,SDINP,SDLT1,SDLT,SDDT,SDMSG,A,L,I,SDV1,SDCL
K ^UTILITY($J)
D LO^DGUTL S SDLT1="",SDYES="",SDDT=DT,I=SDT,SDT=$P(I,".")
S SDMSG=" DOES NOT HAVE A NO-SHOW LETTER ASSIGNED TO IT!"
S SDV1=$O(^DG(40.8,0)) D DIV^SDUTL I $T S SDV1=$P($G(^SC(SC,0)),U,15)
D EN1^SDN,73^SDN,PAUSE^VALM1
NSQ Q 'Y
;
CHK() ; -- check if status of appt permits no-show
N SDOK S SDOK=1
I '$D(^SD(409.63,"ANS",1,+SDSTB)) S SDOK=0,X="You cannot execute no-show processing for this appointment."
I SDOK,SDT>SDTIME S SDOK=1,X="It is too soon to no-show this appointment."
I 'SDOK W !!,*7,X K VALMY(SDI) D PAUSE^VALM1
Q SDOK
;
UPD(BEFORE,AFTER,SDAT,CNST) ; can just the 1 display line be changed w/o re-build
; input: BEFORE := before status info in $$STATUS format
; AFTER := after " " " " "
; SDAT := selected VALMY entry's data
; CNST := consult status (null, consult link ien)
N Y S Y=0
I +BEFORE=+AFTER S Y=1 G UPDQ
I $D(SDAMLIST(+AFTER)) S Y=1 I $D(SDAMLIST("SCR")) X SDAMLIST("SCR") S Y=$T
I 'Y,$P(SDAMLIST,U)="ALL" S Y=1
I Y D
. S ^TMP("SDAM",$J,+SDAT,0)=$$SETFLD^VALM1($P(AFTER,";",3),^TMP("SDAM",$J,+SDAT,0),"STAT")
. ;ihs/cmi/maw 02/27/2011 patch 1015 no consult in IHS
. ;I '$G(CNST) S ^TMP("SDAM",$J,+SDAT,0)=$$SETFLD^VALM1(" ",^TMP("SDAM",$J,+SDAT,0),"CONSULT")
UPDQ Q Y
SDAMN ;ALB/MJK - No-Show Appt Action ; 2/4/92
+1 ;;5.3;Scheduling;**478,1012,1015**;Aug 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 11/09/2000 added extra check before changing checked in
+3 ; appt to no-show
+4 ;
+5 ;cmi/flag/maw 06/02/2010 PATCH 1012 RQMT149 added for list view
+6 ;
EN ; -- protocol SDAM APPT NO-SHOW entry pt
+1 ; input: VALMY := array entries
+2 ;
+3 NEW VALMY,SDI,SDAT,SDTIME,SDNSACT,DFN,SDCL,SDT,SDSTB,SDSTA,SDSTOP
+4 SET VALMBCK=""
SET (SDNSACT,SDSTOP)=0
+5 DO SEL^VALM2
IF '$ORDER(VALMY(0))
GOTO ENQ
+6 DO FULL^VALM1
SET VALMBCK="R"
SET SDI=0
+7 FOR
SET SDI=$ORDER(VALMY(SDI))
IF 'SDI
QUIT
IF $DATA(^TMP("SDAMIDX",$JOB,SDI))
KILL SDAT
SET SDAT=^(SDI)
Begin DoDot:1
+8 ;cmi/maw 6/2/2010 PATCH 1012 for list view
IF $PIECE(SDAT,U,6)]""
WRITE !!,*7,">>> This is not a valid appointment."
DO PAUSE^VALM1
SET SDSTOP=1
QUIT
+9 DO NOW^%DTC
SET SDTIME=%
+10 WRITE !,^TMP("SDAM",$JOB,+SDAT,0),!
+11 SET DFN=+$PIECE(SDAT,U,2)
SET SDT=+$PIECE(SDAT,U,3)
SET SDCL=+$PIECE(SDAT,U,4)
+12 ; before status
SET SDSTB=$$STATUS^SDAM1(DFN,SDT,SDCL,$GET(^DPT(DFN,"S",SDT,0)))
+13 IF '$$CHK
QUIT
+14 ;IHS/ANMC/LJF 11/09/2000
IF $PIECE(SDSTB,";",3)["CHECKED"
IF $$READ^BDGF("YO","Already Checked In. Sure you want to enter No-Show","NO")'=1
QUIT
+15 SET SDSTOP=$$NS(DFN,SDT,SDCL,SDTIME,.SDNSACT)
+16 ; after status
SET SDSTA=$$STATUS^SDAM1(DFN,SDT,SDCL,$GET(^DPT(DFN,"S",SDT,0)))
+17 IF 'SDNSACT
IF '$$UPD(SDSTB,SDSTA,SDAT,$GET(CNSTLNK))
SET SDNSACT=2
End DoDot:1
IF SDSTOP
QUIT
+18 ; values for SDNSACT : 0 = no re-build
+19 ; 1 = re-build because of re-book
+20 ; 2 = re-build because after not for list
+21 IF SDNSACT
IF SDAMTYP="P"
DO BLD^SDAM1
+22 IF SDNSACT
IF SDAMTYP="C"
DO BLD^SDAM3
ENQ QUIT
+1 ;
NS(DFN,SDT,SC,SDTIME,SDNSACT) ; execute no-show code
+1 ; input: DFN := pt file ifn
+2 ; SDT := d/t of appt
+3 ; SC := clinic ifn
+4 ; SDTIME := now
+5 ; SDNSACT := ns processing flag
+6 ; [return] := did user uparrow [ 0|no , 1|yes]
+7 ;
+8 NEW SDI,SDCP,SDYES,SDINP,SDLT1,SDLT,SDDT,SDMSG,A,L,I,SDV1,SDCL
+9 KILL ^UTILITY($JOB)
+10 DO LO^DGUTL
SET SDLT1=""
SET SDYES=""
SET SDDT=DT
SET I=SDT
SET SDT=$PIECE(I,".")
+11 SET SDMSG=" DOES NOT HAVE A NO-SHOW LETTER ASSIGNED TO IT!"
+12 SET SDV1=$ORDER(^DG(40.8,0))
DO DIV^SDUTL
IF $TEST
SET SDV1=$PIECE($GET(^SC(SC,0)),U,15)
+13 DO EN1^SDN
DO 73^SDN
DO PAUSE^VALM1
NSQ QUIT 'Y
+1 ;
CHK() ; -- check if status of appt permits no-show
+1 NEW SDOK
SET SDOK=1
+2 IF '$DATA(^SD(409.63,"ANS",1,+SDSTB))
SET SDOK=0
SET X="You cannot execute no-show processing for this appointment."
+3 IF SDOK
IF SDT>SDTIME
SET SDOK=1
SET X="It is too soon to no-show this appointment."
+4 IF 'SDOK
WRITE !!,*7,X
KILL VALMY(SDI)
DO PAUSE^VALM1
+5 QUIT SDOK
+6 ;
UPD(BEFORE,AFTER,SDAT,CNST) ; can just the 1 display line be changed w/o re-build
+1 ; input: BEFORE := before status info in $$STATUS format
+2 ; AFTER := after " " " " "
+3 ; SDAT := selected VALMY entry's data
+4 ; CNST := consult status (null, consult link ien)
+5 NEW Y
SET Y=0
+6 IF +BEFORE=+AFTER
SET Y=1
GOTO UPDQ
+7 IF $DATA(SDAMLIST(+AFTER))
SET Y=1
IF $DATA(SDAMLIST("SCR"))
XECUTE SDAMLIST("SCR")
SET Y=$TEST
+8 IF 'Y
IF $PIECE(SDAMLIST,U)="ALL"
SET Y=1
+9 IF Y
Begin DoDot:1
+10 SET ^TMP("SDAM",$JOB,+SDAT,0)=$$SETFLD^VALM1($PIECE(AFTER,";",3),^TMP("SDAM",$JOB,+SDAT,0),"STAT")
+11 ;ihs/cmi/maw 02/27/2011 patch 1015 no consult in IHS
+12 ;I '$G(CNST) S ^TMP("SDAM",$J,+SDAT,0)=$$SETFLD^VALM1(" ",^TMP("SDAM",$J,+SDAT,0),"CONSULT")
End DoDot:1
UPDQ QUIT Y
