SDES2GETSTATUS ;ALB/LAB,BWF - VISTA CALL TO GET STATUS; JUL 22, 2024
;;5.3;Scheduling;**871,886**;Aug 13, 1993;Build 13
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
; This is a rewrite of SDEC50 code - rewritten by BWF and then pulled in by LAB
APPTSTATUS(APPTIEN,CLINIEN) ;Get current status for an entry in the SDEC APPOINTMENT file in the style of STATUS^SDAM1
;APPTIEN (R)- IEN of entry in the SDEC APPOINTMENT file (#409.84)
;CLINIEN (O)- IEN of entry in the HOSPITAL LOCATION file (#44); non-count will not be checked via clinic if not passed in (can check via OE)
N STATUS,OUTENCIEN,DFN,APPTDTTM,VAINDT,VADMVT,CHKIO,RET,OESTS,CANCELREASON,CANCELREASONTYP,CANCELSTATUS,STATUSDATE
N APPTIENS,ORIGSTATUSINT,NOSHOW,CANCELDTTM,CHECKOUTDT,NONCOUNT,CKOUTCOMP,APPTDATA,OESTATUS,CHECKINDT
S APPTIENS=APPTIEN_","
D GETS^DIQ(409.84,APPTIENS,".01;.03;.05;.1;.101;.12;.122;.14;.17","IE","APPTDATA","APPTERR")
S APPTDTTM=$G(APPTDATA(409.84,APPTIENS,.01,"I"))
S DFN=$G(APPTDATA(409.84,APPTIENS,.05,"I"))
S OUTENCIEN=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",21,"I")
S CHKIO=""
;
;set initial status value ; non-count clinic?
;
S ORIGSTATUSINT=$G(APPTDATA(409.84,APPTIENS,.17,"I"))
S STATUS=$G(APPTDATA(409.84,APPTIENS,.17,"E"))
;
; initial status date is set to the cancelled date/time
;
S (STATUSDATE,CANCELDTTM)=$G(APPTDATA(409.84,APPTIENS,.12,"I"))
S NONCOUNT=$$GET1^DIQ(44,CLINIEN,2502,"I")
I STATUS="",CLINIEN,NONCOUNT="Y" S STATUS="NON-COUNT" ;check for non-count clinic don't crash if resource/clinic not available
I CLINIEN'="",STATUS="NO ACTION TAKEN",OUTENCIEN'="" S STATUS=""
;
;no show?
;
S NOSHOW=$G(APPTDATA(409.84,APPTIENS,.1,"I"))
I NOSHOW=1 D
. I STATUSDATE]"" D Q ;handle cancel after no-show -- appt STATUS doesn't get updated with cxl but pt status does; 745 STATUSDATE
. .S CANCELREASON=$G(APPTDATA(409.84,APPTIENS,.122,"I"))
. .; Line below revised to use appointment status (field .17) to calculate status when reason is missing
. . I CANCELREASON="" S STATUS=$S(ORIGSTATUSINT="C":"CANCELLED BY CLINIC",ORIGSTATUSINT="PC":"CANCELLED BY PATIENT",1:"CANCELLED") Q
. . S CANCELREASONTYP=$$GET1^DIQ(409.2,CANCELREASON,2,"I")
. . I CANCELREASONTYP="C" S STATUS="CANCELLED BY CLINIC" Q
. . I CANCELREASONTYP="P" S STATUS="CANCELLED BY PATIENT" Q
. . S CANCELSTATUS=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",100)
. . I CANCELSTATUS["CANCELLED" S STATUS=CANCELSTATUS Q
. . S STATUS="CANCELLED BY CLINIC" ;default to clinic if information is lost
. S STATUS="NO-SHOW",STATUSDATE=$G(APPTDATA(409.84,APPTIENS,.101,"I"))
I STATUS=""!(ORIGSTATUSINT="I"),$$INP^SDAM2(DFN,APPTDTTM)="I" D
. S STATUS=$S(CANCELDTTM="":"INPATIENT",$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",3,"I")="PC":"CANCELLED BY PATIENT",1:"CANCELLED BY CLINIC")
N SDNEXTIEN
S SDNEXTIEN=$O(^SDEC(409.84,"APTDT",DFN,APPTDTTM,APPTIEN))
I +$G(SDNEXTIEN),(ORIGSTATUSINT="I"),(CANCELDTTM'="") S STATUS="INPATIENT/CANCELLED"
Q:STATUS="INPATIENT/CANCELLED" STATUS
S VAINDT=APPTDTTM D ADM^VADPT2 ;ADM^VADPT2 assumes VAINDT and returns in VADMVT
;
; Reference to DOMICILIARY WARDS IN MAS PARAMETERS IA #483
; Reference to SERIVCE in WARD LOCATION - IA #1377
; Reference to WARD LOCATION in PATIENT MOVEMENT - IA #358
;
I STATUS["INPATIENT",$S('VADMVT:1,'$$GET1^DIQ(43,1,16,"I"):0,1:$$GET1^DIQ(42,+$$GET1^DIQ(405,VADMVT,.06,"I"),.03,"I")="D") S STATUS=""
; -- determine ci/co indicator
S CHECKINDT=$G(APPTDATA(409.84,APPTIENS,.03,"I"))
S CHECKOUTDT=$G(APPTDATA(409.84,APPTIENS,.14,"I"))
S CHKIO=$S(CHECKOUTDT]"":"CHECKED OUT",CHECKINDT]"":"CHECKED IN",APPTDTTM>(DT+.2400):"FUTURE",1:"NO ACTION TAKEN")
;
; Look for check-in time in the Location file (#44) if check-in/out indicator is NO ACTION TAKEN.
;
I CHKIO="NO ACTION TAKEN",CLINIEN'="" D
. N SFIEN S SFIEN=$$FIND^SDAM2(DFN,APPTDTTM,CLINIEN) I SFIEN,$$GET1^DIQ(44.003,SFIEN_","_APPTDTTM_","_CLINIEN_",",309)'="" S CHKIO="CHECKED IN" ;
S:STATUS="" STATUS=CHKIO
;If NO ACTION TAKEN, If cancelled in Patient(by SDCANCEL)
I STATUS'["CANCELLED" D ;
. I $$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",.01,"I")'=CLINIEN Q ;If appointment does not match, leave status alone.
. S STATUS=$S($$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",3,"I")="PC":"CANCELLED BY PATIENT",$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",3,"I")="C":"CANCELLED BY CLINIC",1:STATUS)
;
I (STATUS="NO ACTION TAKEN"),($P(APPTDTTM,".")=DT),(CHKIO'["CHECKED") S CHKIO="TODAY"
; -- determine print status
I STATUS["CANCELLED" Q STATUS_"^"_STATUSDATE
S RET=$S(STATUS=CHKIO!(CHKIO=""):STATUS,1:"")
S CKOUTCOMP=$$GET1^DIQ(409.68,OUTENCIEN,.07,"I")
I RET="" D
. I STATUS["INPATIENT",$P(APPTDTTM,".",1)>DT S RET=$P(STATUS," ",1)_"/FUTURE" Q
. I (STATUS["INPATIENT"),(CLINIEN]""),(NONCOUNT'="Y"),OUTENCIEN="" S RET=$P(STATUS," ",1)_"/ACT REQ" Q ;no outpatient encounter for inpatient
. I (STATUS["INPATIENT"),(CLINIEN]""),(NONCOUNT'="Y"),(CKOUTCOMP="") S RET=$P(STATUS," ",1)_"/ACT REQ" Q
. I (STATUS="NO ACTION TAKEN"),((CHKIO="CHECKED OUT")!(CHKIO="CHECKED IN")) S RET="ACT REQ/"_CHKIO D Q
. . I (OUTENCIEN),(CKOUTCOMP) S RET="CHECKED OUT"
. I ((STATUS="NO-SHOW")!(STATUS="NON-COUNT")) S RET=STATUS Q:CHKIO="NO ACTION TAKEN"
. S RET=STATUS_"/"_CHKIO
I STATUS["INPATIENT",((CHKIO="")!(CHKIO="NO ACTION TAKEN")) D
. I APPTDTTM>(DT+.2359) S RET=$P(STATUS," ")_"/FUTURE" Q
. S RET=$P(STATUS," ")_"/NO ACT TAKN"
I STATUS["INPATIENT" Q RET
I STATUS["NO-SHOW" Q RET_"^"_STATUSDATE ;745
I ($G(OUTENCIEN)),($D(^SCE(OUTENCIEN,0))) D
. S OESTATUS=$$GET1^DIQ(409.68,OUTENCIEN,.12,"E")
. I $G(OESTATUS)="NON-COUNT" D Q
. . I CHECKOUTDT S RET="NON-COUNT/CHECKED OUT" Q
. . I CHECKINDT S RET="NON-COUNT/CHECKED IN"
. I $G(OESTATUS)="CHECKED OUT" S RET="CHECKED OUT" Q
. I CHECKOUTDT S RET="ACT REQ/CHECKED OUT" D Q
. . I ($G(OESTATUS)=""),(CKOUTCOMP) S RET="CHECKED OUT"
. I CHECKINDT S RET="ACT REQ/CHECKED IN"
Q RET
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETSTATUS 5967 printed Dec 13, 2024@02:54:14 Page 2
SDES2GETSTATUS ;ALB/LAB,BWF - VISTA CALL TO GET STATUS; JUL 22, 2024
+1 ;;5.3;Scheduling;**871,886**;Aug 13, 1993;Build 13
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
+6 ; This is a rewrite of SDEC50 code - rewritten by BWF and then pulled in by LAB
APPTSTATUS(APPTIEN,CLINIEN) ;Get current status for an entry in the SDEC APPOINTMENT file in the style of STATUS^SDAM1
+1 ;APPTIEN (R)- IEN of entry in the SDEC APPOINTMENT file (#409.84)
+2 ;CLINIEN (O)- IEN of entry in the HOSPITAL LOCATION file (#44); non-count will not be checked via clinic if not passed in (can check via OE)
+3 NEW STATUS,OUTENCIEN,DFN,APPTDTTM,VAINDT,VADMVT,CHKIO,RET,OESTS,CANCELREASON,CANCELREASONTYP,CANCELSTATUS,STATUSDATE
+4 NEW APPTIENS,ORIGSTATUSINT,NOSHOW,CANCELDTTM,CHECKOUTDT,NONCOUNT,CKOUTCOMP,APPTDATA,OESTATUS,CHECKINDT
+5 SET APPTIENS=APPTIEN_","
+6 DO GETS^DIQ(409.84,APPTIENS,".01;.03;.05;.1;.101;.12;.122;.14;.17","IE","APPTDATA","APPTERR")
+7 SET APPTDTTM=$GET(APPTDATA(409.84,APPTIENS,.01,"I"))
+8 SET DFN=$GET(APPTDATA(409.84,APPTIENS,.05,"I"))
+9 SET OUTENCIEN=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",21,"I")
+10 SET CHKIO=""
+11 ;
+12 ;set initial status value ; non-count clinic?
+13 ;
+14 SET ORIGSTATUSINT=$GET(APPTDATA(409.84,APPTIENS,.17,"I"))
+15 SET STATUS=$GET(APPTDATA(409.84,APPTIENS,.17,"E"))
+16 ;
+17 ; initial status date is set to the cancelled date/time
+18 ;
+19 SET (STATUSDATE,CANCELDTTM)=$GET(APPTDATA(409.84,APPTIENS,.12,"I"))
+20 SET NONCOUNT=$$GET1^DIQ(44,CLINIEN,2502,"I")
+21 ;check for non-count clinic don't crash if resource/clinic not available
IF STATUS=""
IF CLINIEN
IF NONCOUNT="Y"
SET STATUS="NON-COUNT"
+22 IF CLINIEN'=""
IF STATUS="NO ACTION TAKEN"
IF OUTENCIEN'=""
SET STATUS=""
+23 ;
+24 ;no show?
+25 ;
+26 SET NOSHOW=$GET(APPTDATA(409.84,APPTIENS,.1,"I"))
+27 IF NOSHOW=1
Begin DoDot:1
+28 ;handle cancel after no-show -- appt STATUS doesn't get updated with cxl but pt status does; 745 STATUSDATE
IF STATUSDATE]""
Begin DoDot:2
+29 SET CANCELREASON=$GET(APPTDATA(409.84,APPTIENS,.122,"I"))
+30 ; Line below revised to use appointment status (field .17) to calculate status when reason is missing
+31 IF CANCELREASON=""
SET STATUS=$SELECT(ORIGSTATUSINT="C":"CANCELLED BY CLINIC",ORIGSTATUSINT="PC":"CANCELLED BY PATIENT",1:"CANCELLED")
QUIT
+32 SET CANCELREASONTYP=$$GET1^DIQ(409.2,CANCELREASON,2,"I")
+33 IF CANCELREASONTYP="C"
SET STATUS="CANCELLED BY CLINIC"
QUIT
+34 IF CANCELREASONTYP="P"
SET STATUS="CANCELLED BY PATIENT"
QUIT
+35 SET CANCELSTATUS=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",100)
+36 IF CANCELSTATUS["CANCELLED"
SET STATUS=CANCELSTATUS
QUIT
+37 ;default to clinic if information is lost
SET STATUS="CANCELLED BY CLINIC"
End DoDot:2
QUIT
+38 SET STATUS="NO-SHOW"
SET STATUSDATE=$GET(APPTDATA(409.84,APPTIENS,.101,"I"))
End DoDot:1
+39 IF STATUS=""!(ORIGSTATUSINT="I")
IF $$INP^SDAM2(DFN,APPTDTTM)="I"
Begin DoDot:1
+40 SET STATUS=$SELECT(CANCELDTTM="":"INPATIENT",$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",3,"I")="PC":"CANCELLED BY PATIENT",1:"CANCELLED BY CLINIC")
End DoDot:1
+41 NEW SDNEXTIEN
+42 SET SDNEXTIEN=$ORDER(^SDEC(409.84,"APTDT",DFN,APPTDTTM,APPTIEN))
+43 IF +$GET(SDNEXTIEN)
IF (ORIGSTATUSINT="I")
IF (CANCELDTTM'="")
SET STATUS="INPATIENT/CANCELLED"
+44 if STATUS="INPATIENT/CANCELLED"
QUIT STATUS
+45 ;ADM^VADPT2 assumes VAINDT and returns in VADMVT
SET VAINDT=APPTDTTM
DO ADM^VADPT2
+46 ;
+47 ; Reference to DOMICILIARY WARDS IN MAS PARAMETERS IA #483
+48 ; Reference to SERIVCE in WARD LOCATION - IA #1377
+49 ; Reference to WARD LOCATION in PATIENT MOVEMENT - IA #358
+50 ;
+51 IF STATUS["INPATIENT"
IF $SELECT('VADMVT:1,'$$GET1^DIQ(43,1,16,"I"):0,1:$$GET1^DIQ(42,+$$GET1^DIQ(405,VADMVT,.06,"I"),.03,"I")="D")
SET STATUS=""
+52 ; -- determine ci/co indicator
+53 SET CHECKINDT=$GET(APPTDATA(409.84,APPTIENS,.03,"I"))
+54 SET CHECKOUTDT=$GET(APPTDATA(409.84,APPTIENS,.14,"I"))
+55 SET CHKIO=$SELECT(CHECKOUTDT]"":"CHECKED OUT",CHECKINDT]"":"CHECKED IN",APPTDTTM>(DT+.2400):"FUTURE",1:"NO ACTION TAKEN")
+56 ;
+57 ; Look for check-in time in the Location file (#44) if check-in/out indicator is NO ACTION TAKEN.
+58 ;
+59 IF CHKIO="NO ACTION TAKEN"
IF CLINIEN'=""
Begin DoDot:1
+60 ;
NEW SFIEN
SET SFIEN=$$FIND^SDAM2(DFN,APPTDTTM,CLINIEN)
IF SFIEN
IF $$GET1^DIQ(44.003,SFIEN_","_APPTDTTM_","_CLINIEN_",",309)'=""
SET CHKIO="CHECKED IN"
End DoDot:1
+61 if STATUS=""
SET STATUS=CHKIO
+62 ;If NO ACTION TAKEN, If cancelled in Patient(by SDCANCEL)
+63 ;
IF STATUS'["CANCELLED"
Begin DoDot:1
+64 ;If appointment does not match, leave status alone.
IF $$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",.01,"I")'=CLINIEN
QUIT
+65 SET STATUS=$SELECT($$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",3,"I")="PC":"CANCELLED BY PATIENT",$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",3,"I")="C":"CANCELLED BY CLINIC",1:STATUS)
End DoDot:1
+66 ;
+67 IF (STATUS="NO ACTION TAKEN")
IF ($PIECE(APPTDTTM,".")=DT)
IF (CHKIO'["CHECKED")
SET CHKIO="TODAY"
+68 ; -- determine print status
+69 IF STATUS["CANCELLED"
QUIT STATUS_"^"_STATUSDATE
+70 SET RET=$SELECT(STATUS=CHKIO!(CHKIO=""):STATUS,1:"")
+71 SET CKOUTCOMP=$$GET1^DIQ(409.68,OUTENCIEN,.07,"I")
+72 IF RET=""
Begin DoDot:1
+73 IF STATUS["INPATIENT"
IF $PIECE(APPTDTTM,".",1)>DT
SET RET=$PIECE(STATUS," ",1)_"/FUTURE"
QUIT
+74 ;no outpatient encounter for inpatient
IF (STATUS["INPATIENT")
IF (CLINIEN]"")
IF (NONCOUNT'="Y")
IF OUTENCIEN=""
SET RET=$PIECE(STATUS," ",1)_"/ACT REQ"
QUIT
+75 IF (STATUS["INPATIENT")
IF (CLINIEN]"")
IF (NONCOUNT'="Y")
IF (CKOUTCOMP="")
SET RET=$PIECE(STATUS," ",1)_"/ACT REQ"
QUIT
+76 IF (STATUS="NO ACTION TAKEN")
IF ((CHKIO="CHECKED OUT")!(CHKIO="CHECKED IN"))
SET RET="ACT REQ/"_CHKIO
Begin DoDot:2
+77 IF (OUTENCIEN)
IF (CKOUTCOMP)
SET RET="CHECKED OUT"
End DoDot:2
QUIT
+78 IF ((STATUS="NO-SHOW")!(STATUS="NON-COUNT"))
SET RET=STATUS
if CHKIO="NO ACTION TAKEN"
QUIT
+79 SET RET=STATUS_"/"_CHKIO
End DoDot:1
+80 IF STATUS["INPATIENT"
IF ((CHKIO="")!(CHKIO="NO ACTION TAKEN"))
Begin DoDot:1
+81 IF APPTDTTM>(DT+.2359)
SET RET=$PIECE(STATUS," ")_"/FUTURE"
QUIT
+82 SET RET=$PIECE(STATUS," ")_"/NO ACT TAKN"
End DoDot:1
+83 IF STATUS["INPATIENT"
QUIT RET
+84 ;745
IF STATUS["NO-SHOW"
QUIT RET_"^"_STATUSDATE
+85 IF ($GET(OUTENCIEN))
IF ($DATA(^SCE(OUTENCIEN,0)))
Begin DoDot:1
+86 SET OESTATUS=$$GET1^DIQ(409.68,OUTENCIEN,.12,"E")
+87 IF $GET(OESTATUS)="NON-COUNT"
Begin DoDot:2
+88 IF CHECKOUTDT
SET RET="NON-COUNT/CHECKED OUT"
QUIT
+89 IF CHECKINDT
SET RET="NON-COUNT/CHECKED IN"
End DoDot:2
QUIT
+90 IF $GET(OESTATUS)="CHECKED OUT"
SET RET="CHECKED OUT"
QUIT
+91 IF CHECKOUTDT
SET RET="ACT REQ/CHECKED OUT"
Begin DoDot:2
+92 IF ($GET(OESTATUS)="")
IF (CKOUTCOMP)
SET RET="CHECKED OUT"
End DoDot:2
QUIT
+93 IF CHECKINDT
SET RET="ACT REQ/CHECKED IN"
End DoDot:1
+94 QUIT RET
+95 ;
