- 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
