SDAMN ;ALB/MJK - No-Show Appt Action ; 2/4/92
;;5.3;Scheduling;**478**;Aug 13, 1993
;
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
.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
.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")
. I '$G(CNST) S ^TMP("SDAM",$J,+SDAT,0)=$$SETFLD^VALM1(" ",^TMP("SDAM",$J,+SDAT,0),"CONSULT")
UPDQ Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMN 2676 printed Nov 22, 2024@17:57:44 Page 2
SDAMN ;ALB/MJK - No-Show Appt Action ; 2/4/92
+1 ;;5.3;Scheduling;**478**;Aug 13, 1993
+2 ;
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 DO NOW^%DTC
SET SDTIME=%
+9 WRITE !,^TMP("SDAM",$JOB,+SDAT,0),!
+10 SET DFN=+$PIECE(SDAT,U,2)
SET SDT=+$PIECE(SDAT,U,3)
SET SDCL=+$PIECE(SDAT,U,4)
+11 ; before status
SET SDSTB=$$STATUS^SDAM1(DFN,SDT,SDCL,$GET(^DPT(DFN,"S",SDT,0)))
+12 if '$$CHK
QUIT
+13 SET SDSTOP=$$NS(DFN,SDT,SDCL,SDTIME,.SDNSACT)
+14 ; after status
SET SDSTA=$$STATUS^SDAM1(DFN,SDT,SDCL,$GET(^DPT(DFN,"S",SDT,0)))
+15 IF 'SDNSACT
IF '$$UPD(SDSTB,SDSTA,SDAT,$GET(CNSTLNK))
SET SDNSACT=2
End DoDot:1
if SDSTOP
QUIT
+16 ; values for SDNSACT : 0 = no re-build
+17 ; 1 = re-build because of re-book
+18 ; 2 = re-build because after not for list
+19 IF SDNSACT
IF SDAMTYP="P"
DO BLD^SDAM1
+20 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 IF '$GET(CNST)
SET ^TMP("SDAM",$JOB,+SDAT,0)=$$SETFLD^VALM1(" ",^TMP("SDAM",$JOB,+SDAT,0),"CONSULT")
End DoDot:1
UPDQ QUIT Y
