SDES2GETVISIT ;ALB/JAS,TJB - SDES2 VISTA SCHEDULING API for Visit Retrieval and Checkin functions ;Jun 17, 2024
;;5.3;Scheduling;**878,881**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;
; Based off of SDECAPI4 & SDECAPI with portions of code pulled from SDECU2 & SDECV
;
Q
;
GETVISIT(SDOUTPUT,SDINPUT) ;Private Entry Point
; >> All date/time variables must be in FileMan internal format
; Special Incoming Variables:
; SDINPUT("FORCE ADD") = 1 ; no matter what, create new visit (Optional)
; SDINPUT("NEVER ADD") = 1 ; never add visit, just try to find one or more (Optional)
; SDINPUT("ANCILLARY") = 1 ; for ancillary packages to create noon visit if no match found (Optional)
; SDINPUT("SHOW VISITS") = 1 ; this will display visits if more than one match
; Incoming Variables used in Matching: REQUIRED
; SDINPUT("PAT") = patient IEN (file 2 or 9000001)
; SDINPUT("VISIT DATE") = visit date & time (same as check-in date & time)
; SDINPUT ("SITE") = location of encounter IEN (file 4 or 9999999.06)
; SDINPUT("VISIT TYPE") = internal value for field .03 in Visit file
; SDINPUT("SRV CAT") = internal value for service category
; SDINPUT("TIME RANGE") = # ; range in minutes for matching on visit time; REQUIRED unless FORCE ADD set
; ; zero=exact matches only; -1=don't match on time
; These are used to match if sent (Optional)
; SDINPUT("PROVIDER") = IEN for provider to match from file 200
; SDINPUT("CLINIC CODE") = IEN of clinic stop code (file 40.7)
; SDINPUT("HOS LOC") = IEN of hospital location (file 44, field .22 in VISIT file)
; Incoming Variables used in creating appt and visit
; SDINPUT("APPT DATE") = appt date & time (Required for scheduled appts and walk-ins; check-in will be performed)
; SDINPUT("USR") = user IEN in file 200; REQUIRED
; SDINPUT("OPT") = name for Option Used To Create field, for check-in only (Optional)
; SDINPUT("OI") = reason for appointment; for walk-ins (Optional)
; Incoming PCC variables for adding additional info to visit (Optional)
; SDINPUT("SDTPB") = Third Party Billed (#.04)
; SDINPUT("SDPVL") = Parent Visit Link (#.12)
; SDINPUT("SDAPPT") = WalkIn/Appt (#.16)
; SDINPUT("SDEVM") = Evaluation and Management Code (#.17)
; SDINPUT("SDCODT") = Check Out Date & Time (#.18)
; SDINPUT("SDLS") = Level of Service -PCC Form (#.19).
; SDINPUT("SDVELG") = Eligibility (#.21)
; SDINPUT("SDPROT") = Protocol (#.25).
; SDINPUT("SDOPT") = Option Used To Create (#.24)
; SDINPUT("SDOLOC") = Outside Location (#2101)
; Outgoing Array:
; SDOUTPUT(0) always set; if = 0 none found and may have error message in 2nd piece
; if = 1 and SDOUTPUT(visit ien)="ADD" new visit just created
; if = 1 and SDOUTPUT(visit ien)=#; # is time difference in minutes
; if >1, multiple SDOUTPUT(visit ien) entries exist
N SDARRAY K SDOUTPUT
M SDARRAY=SDINPUT ;preserve incoming array
I '$$HAVEREQ(.SDOUTPUT,.SDARRAY) Q ;check required fields
I '$G(SDARRAY("SDOPT")) D
. I $G(SDARRAY("OPT"))]"",SDARRAY("OPT")?.N,$D(^DIC(19,SDARRAY("OPT"))) S SDARRAY("SDOPT")=SDARRAY("OPT") Q
. I $G(SDARRAY("OPT"))]"",$E(SDARRAY("OPT"),1,1)="`" S SDARRAY("SDOPT")=$TR(SDARRAY("OPT"),"`") Q
. I $G(SDARRAY("OPT"))]"",SDARRAY("OPT")'?.N S SDARRAY("SDOPT")=$O(^DIC(19,"B",SDARRAY("OPT"),0)) Q
. I $G(SDARRAY("SDOPT"))]"",$E(SDARRAY("SDOPT"),1,1)="`" S SDARRAY("SDOPT")=$TR(SDARRAY("SDOPT"),"`") Q
. I $G(SDARRAY("SDOPT"))]"",SDARRAY("SDOPT")'?.N S SDARRAY("SDOPT")=$O(^DIC(19,"B",SDARRAY("SDOPT"),0)) Q
I $G(SDARRAY("FORCE ADD")) D ADDVIST(.SDOUTPUT,.SDARRAY) Q
; attempt to find matching visits; return SDOUTPUT array
I '$G(SDARRAY("FORCE ADD")) D MATCH(.SDOUTPUT,.SDARRAY)
; if no appointment date/time sent, just create visit and quit
I '$G(SDARRAY("APPT DATE")) D ADDVIST(.SDOUTPUT,.SDARRAY) Q
; if one matching visit found, continue to check-in
I SDOUTPUT(0)=1 S SDARRAY("VIEN")=$O(SDOUTPUT(0))
; if patient already has appt at this time, call Check-in then quit
N IEN,ERR,VISIT
S IEN=$$SCIEN(SDARRAY("PAT"),SDARRAY("HOS LOC"),SDARRAY("APPT DATE")) ;find appt
I IEN D Q
. ; set variables used by checkin call
. S SDARRAY("CDT")=SDARRAY("VISIT DATE")
. S SDARRAY("CC")=$G(SDARRAY("CLINIC CODE"))
. S SDARRAY("PRV")=$G(SDARRAY("PROVIDER"))
. S SDARRAY("CLN")=$G(SDARRAY("HOS LOC"))
. S SDARRAY("ADT")=$G(SDARRAY("APPT DATE"))
. S ERR=$$CHECKIN(.SDARRAY) ;check in
. ; reset SDOUTPUT only if truly added one.
. I 'ERR S VISIT=$$GETVST(SDARRAY("PAT"),SDARRAY("APPT DATE")) I VISIT,'$G(SDARRAY("VIEN")) S:SDOUTPUT(0)=0 SDOUTPUT(0)=1 S SDOUTPUT(VISIT)="ADD" Q
. I ERR S SDOUTPUT(0)=0_U_$P(ERR,U,2)
; else call walk-in (which calls make appt, checkin and create visit)
D WALKIN(.SDOUTPUT,.SDARRAY)
Q
;
MATCH(SDOUT,SDINPUT) ; find matching visits based on input array
S SDOUT(0)=0
N END,DATE,VIEN,STOP,DIFF,MATCH
S MATCH=0
D TIME(SDINPUT("TIME RANGE"),SDINPUT("VISIT DATE"),.DATE,.END)
F S DATE=$O(^AUPNVSIT("AA",SDINPUT("PAT"),DATE)) Q:'DATE Q:(DATE>END) D
. S VIEN=0
. F S VIEN=$O(^AUPNVSIT("AA",SDINPUT("PAT"),DATE,VIEN)) Q:'VIEN D
. . I $$GET1^DIQ(9000010,VIEN,.11)="DELETED" Q ;check for delete flag just in case xref not killed
. . I SDINPUT("SITE")'=$$GET1^DIQ(9000010,VIEN,.06,"I") Q ;no match on loc of enc
. . I SDINPUT("VISIT TYPE")'=$$GET1^DIQ(9000010,VIEN,.03,"I") Q ;no match on visit type
. . ; get observation and day surgery visits
. . I SDINPUT("SRV CAT")["CENRT" Q ;don't look at HIM excluded visits
. . I $$GET1^DIQ(90000010,VIEN,.07,"I")["CENRT" Q ;don't look at HIM excluded visits
. . I SDINPUT("SRV CAT")=$$GET1^DIQ(9000010,VIEN,.07,"I") S MATCH=1 ;no match on service category
. . I SDINPUT("SRV CAT")="A",$G(SDINPUT("ANCILLARY")),$$GET1^DIQ(9000010,VIEN,.07,"I")="O" S MATCH=1 ;match if observation
. . I SDINPUT("SRV CAT")="A",$G(SDINPUT("ANCILLARY")),$$GET1^DIQ(9000010,VIEN,.07,"I")="D" S MATCH=1
. . I '$G(MATCH) Q
. . I SDINPUT("TIME RANGE")>-1 S STOP=0 D Q:STOP ;check time range
. . . S DIFF=$$TIMEDIF(SDINPUT("VISIT DATE"),VIEN) ;find difference in minutes
. . . I $$ABS^XLFMTH(DIFF)>SDINPUT("TIME RANGE") S STOP=1
. . I '$$PRVMTCH(.SDINPUT,VIEN) Q ; if provider sent and didn't match, skip
. . ; if called by ancillary, falls through and sets visit into array
. . ; otherwise, check if app wants to match on clinic code or hosp location
. . I '$G(SDINPUT("ANCILLARY")) S STOP=0 D Q:STOP
. . . I $G(SDINPUT("HOS LOC")),'$G(SDINPUT("CLINIC CODE")) S SDINPUT("CLINIC CODE")=$$GET1^DIQ(44,SDINPUT("HOS LOC"),8,"I")
. . . I $G(SDINPUT("CLINIC CODE")),SDINPUT("CLINIC CODE")'=$$GET1^DIQ(9000010,VIEN,.08,"I") S STOP=1 Q ;no match on clinic code
. . . ; if both have appt date and visit was triage clinic, is a match
. . . ; create visit on same day no matter what
. . . I $G(SDINPUT("HOS LOC")),(SDINPUT("HOS LOC")'=$$GET1^DIQ(9000010,VIEN,.22,"I")) S STOP=1 Q ;no match on hospital location
. . . ; if same clinic & same provider but not triage, make new visit
. . . I $G(SDINPUT("APPT DATE")),$$GET1^DIQ(9000010,VIEN,.26,"I"),'$$TRIAGE(VIEN) S STOP=1 Q
. . ; must be good match, increment counter and set array node
. . S SDOUT(0)=SDOUT(0)+1
. . S SDOUT(VIEN)=$$TIMEDIF(SDINPUT("VISIT DATE"),VIEN)
Q
;
PRVMTCH(SDINPUT,VIEN) ; do visits match on provider?
N PRVS,IEN
I '$G(SDINPUT("PROVIDER")) Q 1 ; if no provider sent, assume okay
; if visit is triage clinic & new encounter is not ancillary, skip provider match
I $$TRIAGE(VIEN),'$G(SDINPUT("ANCILLARY")) Q 1
; find all v provider entries for visit
S IEN=0 F S IEN=$O(^AUPNVPRV("AD",VIEN,IEN)) Q:'IEN D
. S PRVS($$GET1^DIQ(9000010.06,IEN_",",.01,"I"))=""
; if incoming provider in list, this is match
I $D(PRVS(SDINPUT("PROVIDER"))) Q 1
; otherwise, no match
Q 0
;
TIMEDIF(VDTTM,VIEN) ; return time diff between incoming time and current visit
Q $$FMDIFF^XLFDT(VDTTM,+$G(^AUPNVSIT(VIEN,0)),2)\60
;
ADDVIST(SDOUTPUT,SDARRAY) ;
N %DT,SDVISITIN,SUB,X,Y
S SUB="SD" F S SUB=$O(SDARRAY(SUB)) Q:SUB="" Q:$E(SUB,1,2)'="SD" S SDVISITIN(SUB)=SDARRAY(SUB)
S SDVISITIN("AUPNTALK")="",SDVISITIN("SDANE")="" ;keep it silent
S SDVISITIN("SDLOC")=$G(SDARRAY("SITE")) ;facility
S SDVISITIN("SDPAT")=$G(SDARRAY("PAT")) ;patient
S SDVISITIN("SDTYPE")=$G(SDARRAY("VISIT TYPE")) ;visit type
S SDVISITIN("SDCAT")=$G(SDARRAY("SRV CAT")) ;srv cat
S SDVISITIN("SDDATE")=$G(SDARRAY("VISIT DATE")) ;chkin dt
I $G(SDARRAY("CLINIC CODE")) S SDVISITIN("SDCLN")="`"_SDARRAY("CLINIC CODE") ;clinic code ien w/`
S SDVISITIN("SDHL")=$G(SDARRAY("HOS LOC")) ;clinic name
S SDVISITIN("SDAPDT")=$G(SDARRAY("APPT DATE")) ;appt date
S SDVISITIN("SDUSR")=$G(SDARRAY("USR"))
S SDVISITIN("SDADD")=1 ;force add
; create visit
N SDVISITOUT
D EN1^SDES2CRTVISIT(.SDVISITOUT,.SDVISITIN)
; if no visit created,error quit
I '$G(SDVISITOUT("SDVSIT")) D Q
. S SDOUTPUT(0)="0^Error Creating Visit"
; set new visit info in out array
S SDOUTPUT(SDVISITOUT("SDVSIT"))="ADD",SDOUTPUT(0)=1
K SDVISITIN,SDVISITOUT
Q
;
WALKIN(SDOUT,SDWALKIN) ;Create walkin appt which is checked in and visit created
N ERR,VISIT
S SDOUT(0)=0 ;initialize outgoing count
S SDWALKIN("CLN")=$G(SDWALKIN("HOS LOC"))
S SDWALKIN("TYP")=4 ;4=walkin
S SDWALKIN("ADT")=$G(SDWALKIN("APPT DATE"))
I '$D(SDWALKIN("LEN")) S SDWALKIN("LEN")=$$GET1^DIQ(44,SDWALKIN("CLN"),1912)
; make walkin appt
S ERR=$$MAKE(.SDWALKIN) I ERR S $P(SDOUT(0),U,2)=$P(ERR,U,2) Q
; set variables used by checkin call
S SDWALKIN("CDT")=SDWALKIN("VISIT DATE")
S SDWALKIN("CC")=$G(SDWALKIN("CLINIC CODE"))
S SDWALKIN("PRV")=$G(SDWALKIN("PROVIDER"))
; check in appt and create visit
S ERR=$$CHECKIN(.SDWALKIN)
; update out array based on result
; reset SDOUTPUT(0) only if added new visit
I 'ERR S VISIT=$$GETVST(SDWALKIN("PAT"),SDWALKIN("APPT DATE")) I VISIT,'$G(SDARRAY("VIEN")) S:SDOUT(0)=0 SDOUT(0)=1 S SDOUT(VISIT)="ADD" ;visit added
I ERR S $P(SDOUT(0),U,2)=$P(ERR,U,2) ;error
Q
;
HAVEREQ(SDOUT,SDINPUT) ; check required fields
I '$G(SDINPUT("FORCE ADD")),'$D(SDINPUT("TIME RANGE")) S SDOUT(0)="0^Missing Time Range" Q 0
I '$D(SDINPUT("PAT")) S SDOUT(0)="0^Missing Patient IEN" Q 0
I '$D(SDINPUT("VISIT DATE")) S SDOUT(0)="0^Missing Visit Date" Q 0
I '$D(SDINPUT("SITE")) S SDOUT(0)="0^Missing Facility/Site" Q 0
I '$D(SDINPUT("VISIT TYPE")) S SDOUT(0)="0^Missing Visit Type" Q 0
I '$D(SDINPUT("SRV CAT")) S SDOUT(0)="0^Missing Service Category" Q 0
I '$D(SDINPUT("USR")) S SDOUT(0)="0^Missing User IEN" Q 0
I $G(SDINPUT("HOS LOC")),'$G(SDINPUT("CLINIC CODE")) S SDINPUT("CLINIC CODE")=$$GET1^DIQ(44,SDINPUT("HOS LOC"),8,"I")
; convert service category
I $G(SDINPUT("APPT DATE")),$G(SDINPUT("HOS LOC")) S SDINPUT("SRV CAT")=$$SERCAT(SDINPUT("HOS LOC"),SDINPUT("PAT"))
Q 1
;
TIME(RANGE,VISIT,DATE,END) ; set DATE and END based on TIME RANGE setting in minutes
N TMDIF,SW
S TMDIF=$S(RANGE<1:0,1:RANGE)
S DATE=$$FMADD^XLFDT(VISIT,,,-TMDIF)
S END=$$FMADD^XLFDT(VISIT,,,TMDIF)
I (DATE\1)<(END\1) S SW=(END\1),END=(DATE\1)_".9999",DATE=SW
S DATE=(9999999-(DATE\1)_"."_$P(DATE,".",2))-.0001
S END=9999999-(END\1)_"."_$P(END,".",2)
I RANGE=-1 S END=(END\1)_".9999",DATE=(DATE\1) ;no time range used
Q
;
TRIAGE(VST) ; returns 1 if visit's hosp loc is triage type
N HSPLOC
S HSPLOC=$$GET1^DIQ(9000010,VST,.22,"I") I 'HSPLOC Q 0
Q +$$GET1^DIQ(9009017.2,HSPLOC,.16,"I")
;
MAKE(SDAPPTIN) ;Call to store appt made
;
; Make call using: S ERR=$$MAKE^SDES2GETVISIT(.ARRAY)
;
; Input Array -
; SDAPPTIN("PAT") = ien of patient in file 2
; SDAPPTIN("CLN") = ien of clinic in file 44
; SDAPPTIN("TYP") = 3 for scheduled appts, 4 for walkins
; SDAPPTIN("ADT") = appointment date and time
; SDAPPTIN("LEN") = appointment length in minutes (5-240)
; SDAPPTIN("OI") = reason for appt - up to 150 characters
; SDAPPTIN("USR") = user who made appt
;
; Output: error status and message
; = 0 or null: everything okay
; = 1^message: error and reason
;
N SDERROR
I '$D(^DPT(+$G(SDAPPTIN("PAT")),0)) Q 1_U_"Patient not on file: "_$G(SDAPPTIN("PAT"))
I '$D(^SC(+$G(SDAPPTIN("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(SDAPPTIN("CLN"))
I ($G(SDAPPTIN("TYP"))<3)!($G(SDAPPTIN("TYP"))>4) Q 1_U_"Appt Type error: "_$G(SDAPPTIN("TYP"))
I $G(SDAPPTIN("ADT"))'?7N1"."1N.N Q 1_U_"Appt Date/Time error: "_$G(SDAPPTIN("ADT")) ;PWC allow any time combination of numbers #694
I ($G(SDAPPTIN("LEN"))<5)!($G(SDAPPTIN("LEN"))>240) Q 1_U_"Appt Length error: "_$G(SDAPPTIN("LEN"))
I '$D(^VA(200,+$G(SDAPPTIN("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(SDAPPTIN("USR"))
I $D(^DPT(SDAPPTIN("PAT"),"S",SDAPPTIN("ADT"),0)),$$GET1^DIQ(2.98,SDAPPTIN("ADT")_","_SDAPPTIN("PAT")_",",3,"I")'="C" Q 1_U_"Patient "_SDAPPTIN("PAT")_" already has appt at "_SDAPPTIN("ADT")
;
N DIC,DA,Y,X,DD,DO,DLAYGO
I $D(^DPT(SDAPPTIN("PAT"),"S",SDAPPTIN("ADT"),0)),$$GET1^DIQ(2.98,SDAPPTIN("ADT")_","_SDAPPTIN("PAT")_",",3,"I")="C" D
. ; "un-cancel" existing appt in file 2
. N SDAPPTFDA,SDAPPTIENS,SDAPPTERR
. S SDAPPTIENS=SDAPPTIN("ADT")_","_SDAPPTIN("PAT")_","
. S SDAPPTFDA(2.98,SDAPPTIENS,".01")=SDAPPTIN("CLN")
. S SDAPPTFDA(2.98,SDAPPTIENS,"3")=""
. S SDAPPTFDA(2.98,SDAPPTIENS,"9")=SDAPPTIN("TYP")
. S SDAPPTFDA(2.98,SDAPPTIENS,"9.5")=9
. S SDAPPTFDA(2.98,SDAPPTIENS,"14")=""
. S SDAPPTFDA(2.98,SDAPPTIENS,"15")=""
. S SDAPPTFDA(2.98,SDAPPTIENS,"16")=""
. S SDAPPTFDA(2.98,SDAPPTIENS,"19")=""
. S SDAPPTFDA(2.98,SDAPPTIENS,"20")=$$NOW^XLFDT
. D FILE^DIE("","SDAPPTFDA","SDAPPTERR")
. N SDAPPTTMP S SDAPPTTMP=$G(SDAPPTERR)
E D I $G(SDERROR(1)) Q 1_U_"FileMan add to DPT error: Patient="_SDAPPTIN("PAT")_" Appt="_SDAPPTIN("ADT")
. ; add appt to file 2
. ; call to silent server call
. N SDAPPTFDA,SDAPPTIENS,SDAPPTERR
. S SDAPPTIENS="?+2,"_SDAPPTIN("PAT")_","
. S SDAPPTIENS(2)=SDAPPTIN("ADT")
. S SDAPPTFDA(2.98,SDAPPTIENS,.01)=SDAPPTIN("CLN")
. S SDAPPTFDA(2.98,SDAPPTIENS,"9")=SDAPPTIN("TYP")
. S SDAPPTFDA(2.98,SDAPPTIENS,"9.5")=9
. S SDAPPTFDA(2.98,SDAPPTIENS,"20")=$$NOW^XLFDT
. D UPDATE^DIE("","SDAPPTFDA","SDAPPTIENS","SDERROR(1)")
;
; add appt to file 44
K DIC,DA,X,Y,DLAYGO,DD,DO
I '$D(^SC(SDAPPTIN("CLN"),"S",0)) S ^SC(SDAPPTIN("CLN"),"S",0)="^44.001DA^^"
I '$D(^SC(SDAPPTIN("CLN"),"S",SDAPPTIN("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_SDAPPTIN("CLN")_" Date="_SDAPPTIN("ADT")
. S DIC="^SC("_SDAPPTIN("CLN")_",""S"",",DA(1)=SDAPPTIN("CLN"),(X,DINUM)=SDAPPTIN("ADT")
. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
. S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
;
K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
S DIC="^SC("_SDAPPTIN("CLN")_",""S"","_SDAPPTIN("ADT")_",1,"
S DA(2)=SDAPPTIN("CLN"),DA(1)=SDAPPTIN("ADT"),X=SDAPPTIN("PAT")
S DIC("DR")="1///"_SDAPPTIN("LEN")_";3///"_$E($G(SDAPPTIN("OI")),1,150)_";7///"_SDAPPTIN("USR")_";8///"_$$NOW^XLFDT
S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
D FILE^DICN
;
; call event driver
N DFN,SDT,SDCL,SDDA,SDMODE
S DFN=SDAPPTIN("PAT"),SDT=SDAPPTIN("ADT"),SDCL=SDAPPTIN("CLN"),SDMODE=2
S SDDA=$$SCIEN(SDAPPTIN("PAT"),SDAPPTIN("CLN"),SDAPPTIN("ADT"))
D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
Q 0
;
CHECKIN(SDAPPTIN) ;Call to add checkin info to appt
;
; Input array -
; SDAPPTIN("PAT") = ien of patient in file 2
; SDAPPTIN("CLN") = ien of clinic in file 44
; SDAPPTIN("ADT") = appt date/time
; SDAPPTIN("CDT") = checkin date/time
; SDAPPTIN("USR") = checkin user
; SDAPPTIN("OPT") = option used to create visit (optional)
; SDAPPTIN("VIEN") = visit IEN (sent if new visit is NOT to be created)
;
; variables to create visit under event driver
; SDAPPTIN("CC") = clinic code for creating visit - optional
; SDAPPTIN("PRV") = visit provider - pointer to file 200
;
; Output value = 0 (successful)
; = 1^error message
;
I '$D(^DPT(+$G(SDAPPTIN("PAT")),0)) Q 1_U_"Patient not on file: "_$G(SDAPPTIN("PAT"))
I '$D(^SC(+$G(SDAPPTIN("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(SDAPPTIN("CLN"))
I $G(SDAPPTIN("ADT"))'?7N1"."1N.N Q 1_U_"Appt Date/Time error: "_$G(SDAPPTIN("ADT"))
I $G(SDAPPTIN("CDT"))'?7N1"."1N.N Q 1_U_"Checkin Date/Time error: "_$G(SDAPPTIN("CDT"))
I '$D(^VA(200,+$G(SDAPPTIN("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(SDAPPTIN("USR"))
;
; find ien for appt in file 44
N IEN,DIE,DA,DR,SDVSTN
S IEN=$$SCIEN(SDAPPTIN("PAT"),SDAPPTIN("CLN"),SDAPPTIN("ADT"))
I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_SDAPPTIN("PAT")_" Clinic="_SDAPPTIN("CLN")_" Appt="_SDAPPTIN("ADT")
;
; remember before status
N SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
S DFN=SDAPPTIN("PAT"),SDT=SDAPPTIN("ADT"),SDCL=SDAPPTIN("CLN"),SDMODE=2,SDDA=IEN
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
;
; set checkin
N SDFDA
S SDFDA(44.003,IEN_","_SDAPPTIN("ADT")_","_SDAPPTIN("CLN")_",",305)=$$NOW^XLFDT()
S SDFDA(44.003,IEN_","_SDAPPTIN("ADT")_","_SDAPPTIN("CLN")_",",309)=SDAPPTIN("CDT")
D FILE^DIE("","SDFDA")
K SDFDA
; Updating 302 separately because of trigger on field 309 uses logged-in DUZ
S SDFDA(44.003,IEN_","_SDAPPTIN("ADT")_","_SDAPPTIN("CLN")_",",302)=SDAPPTIN("USR")
D FILE^DIE("","SDFDA")
;
; set after status
S SDDA=$$SCIEN(SDAPPTIN("PAT"),SDAPPTIN("CLN"),SDAPPTIN("ADT"))
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
;
Q 0
;
SERCAT(CLINIC,PAT) ;Returns service category for visit
N CLNCAT
I $$GET1^DIQ(2,PAT_",",.1)]"" Q "I" ;in hospital if inpt
S CLNCAT=$$GET1^DIQ(9009017.2,CLINIC,.12,"I") ;clinic's service category
Q $S(CLNCAT]"":CLNCAT,1:"A")
;
SCIEN(PAT,CLINIC,DATE) ;Returns ien for appt in ^SC
N APPTIEN,VALIDIEN
S APPTIEN=0 F S APPTIEN=$O(^SC(CLINIC,"S",DATE,1,APPTIEN)) Q:'APPTIEN Q:$G(VALIDIEN) D
. Q:$$GET1^DIQ(44.003,APPTIEN_","_DATE_","_CLINIC,310,"I")="C" ;cancelled
. I $$GET1^DIQ(44.003,APPTIEN_","_DATE_","_CLINIC,.01,"I")=PAT S VALIDIEN=APPTIEN
Q $G(VALIDIEN)
;
GETVST(PAT,DATE) ;Returns visit ien for appt date and patient
I ('PAT)!('DATE) Q 0
N OUTPTENC
S OUTPTENC=$$GET1^DIQ(2.98,DATE_","_PAT_",",21,"I")
I 'OUTPTENC Q 0 ;outpt encounter ptr
;
I $$GET1^DIQ(409.68,OUTPTENC_",",.02,"I")'=PAT Q 0 ;patient ptr
Q $$GET1^DIQ(409.68,OUTPTENC_",",.05,"I") ;visit ptr
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETVISIT 19054 printed Dec 13, 2024@02:54:18 Page 2
SDES2GETVISIT ;ALB/JAS,TJB - SDES2 VISTA SCHEDULING API for Visit Retrieval and Checkin functions ;Jun 17, 2024
+1 ;;5.3;Scheduling;**878,881**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Based off of SDECAPI4 & SDECAPI with portions of code pulled from SDECU2 & SDECV
+5 ;
+6 QUIT
+7 ;
GETVISIT(SDOUTPUT,SDINPUT) ;Private Entry Point
+1 ; >> All date/time variables must be in FileMan internal format
+2 ; Special Incoming Variables:
+3 ; SDINPUT("FORCE ADD") = 1 ; no matter what, create new visit (Optional)
+4 ; SDINPUT("NEVER ADD") = 1 ; never add visit, just try to find one or more (Optional)
+5 ; SDINPUT("ANCILLARY") = 1 ; for ancillary packages to create noon visit if no match found (Optional)
+6 ; SDINPUT("SHOW VISITS") = 1 ; this will display visits if more than one match
+7 ; Incoming Variables used in Matching: REQUIRED
+8 ; SDINPUT("PAT") = patient IEN (file 2 or 9000001)
+9 ; SDINPUT("VISIT DATE") = visit date & time (same as check-in date & time)
+10 ; SDINPUT ("SITE") = location of encounter IEN (file 4 or 9999999.06)
+11 ; SDINPUT("VISIT TYPE") = internal value for field .03 in Visit file
+12 ; SDINPUT("SRV CAT") = internal value for service category
+13 ; SDINPUT("TIME RANGE") = # ; range in minutes for matching on visit time; REQUIRED unless FORCE ADD set
+14 ; ; zero=exact matches only; -1=don't match on time
+15 ; These are used to match if sent (Optional)
+16 ; SDINPUT("PROVIDER") = IEN for provider to match from file 200
+17 ; SDINPUT("CLINIC CODE") = IEN of clinic stop code (file 40.7)
+18 ; SDINPUT("HOS LOC") = IEN of hospital location (file 44, field .22 in VISIT file)
+19 ; Incoming Variables used in creating appt and visit
+20 ; SDINPUT("APPT DATE") = appt date & time (Required for scheduled appts and walk-ins; check-in will be performed)
+21 ; SDINPUT("USR") = user IEN in file 200; REQUIRED
+22 ; SDINPUT("OPT") = name for Option Used To Create field, for check-in only (Optional)
+23 ; SDINPUT("OI") = reason for appointment; for walk-ins (Optional)
+24 ; Incoming PCC variables for adding additional info to visit (Optional)
+25 ; SDINPUT("SDTPB") = Third Party Billed (#.04)
+26 ; SDINPUT("SDPVL") = Parent Visit Link (#.12)
+27 ; SDINPUT("SDAPPT") = WalkIn/Appt (#.16)
+28 ; SDINPUT("SDEVM") = Evaluation and Management Code (#.17)
+29 ; SDINPUT("SDCODT") = Check Out Date & Time (#.18)
+30 ; SDINPUT("SDLS") = Level of Service -PCC Form (#.19).
+31 ; SDINPUT("SDVELG") = Eligibility (#.21)
+32 ; SDINPUT("SDPROT") = Protocol (#.25).
+33 ; SDINPUT("SDOPT") = Option Used To Create (#.24)
+34 ; SDINPUT("SDOLOC") = Outside Location (#2101)
+35 ; Outgoing Array:
+36 ; SDOUTPUT(0) always set; if = 0 none found and may have error message in 2nd piece
+37 ; if = 1 and SDOUTPUT(visit ien)="ADD" new visit just created
+38 ; if = 1 and SDOUTPUT(visit ien)=#; # is time difference in minutes
+39 ; if >1, multiple SDOUTPUT(visit ien) entries exist
+40 NEW SDARRAY
KILL SDOUTPUT
+41 ;preserve incoming array
MERGE SDARRAY=SDINPUT
+42 ;check required fields
IF '$$HAVEREQ(.SDOUTPUT,.SDARRAY)
QUIT
+43 IF '$GET(SDARRAY("SDOPT"))
Begin DoDot:1
+44 IF $GET(SDARRAY("OPT"))]""
IF SDARRAY("OPT")?.N
IF $DATA(^DIC(19,SDARRAY("OPT")))
SET SDARRAY("SDOPT")=SDARRAY("OPT")
QUIT
+45 IF $GET(SDARRAY("OPT"))]""
IF $EXTRACT(SDARRAY("OPT"),1,1)="`"
SET SDARRAY("SDOPT")=$TRANSLATE(SDARRAY("OPT"),"`")
QUIT
+46 IF $GET(SDARRAY("OPT"))]""
IF SDARRAY("OPT")'?.N
SET SDARRAY("SDOPT")=$ORDER(^DIC(19,"B",SDARRAY("OPT"),0))
QUIT
+47 IF $GET(SDARRAY("SDOPT"))]""
IF $EXTRACT(SDARRAY("SDOPT"),1,1)="`"
SET SDARRAY("SDOPT")=$TRANSLATE(SDARRAY("SDOPT"),"`")
QUIT
+48 IF $GET(SDARRAY("SDOPT"))]""
IF SDARRAY("SDOPT")'?.N
SET SDARRAY("SDOPT")=$ORDER(^DIC(19,"B",SDARRAY("SDOPT"),0))
QUIT
End DoDot:1
+49 IF $GET(SDARRAY("FORCE ADD"))
DO ADDVIST(.SDOUTPUT,.SDARRAY)
QUIT
+50 ; attempt to find matching visits; return SDOUTPUT array
+51 IF '$GET(SDARRAY("FORCE ADD"))
DO MATCH(.SDOUTPUT,.SDARRAY)
+52 ; if no appointment date/time sent, just create visit and quit
+53 IF '$GET(SDARRAY("APPT DATE"))
DO ADDVIST(.SDOUTPUT,.SDARRAY)
QUIT
+54 ; if one matching visit found, continue to check-in
+55 IF SDOUTPUT(0)=1
SET SDARRAY("VIEN")=$ORDER(SDOUTPUT(0))
+56 ; if patient already has appt at this time, call Check-in then quit
+57 NEW IEN,ERR,VISIT
+58 ;find appt
SET IEN=$$SCIEN(SDARRAY("PAT"),SDARRAY("HOS LOC"),SDARRAY("APPT DATE"))
+59 IF IEN
Begin DoDot:1
+60 ; set variables used by checkin call
+61 SET SDARRAY("CDT")=SDARRAY("VISIT DATE")
+62 SET SDARRAY("CC")=$GET(SDARRAY("CLINIC CODE"))
+63 SET SDARRAY("PRV")=$GET(SDARRAY("PROVIDER"))
+64 SET SDARRAY("CLN")=$GET(SDARRAY("HOS LOC"))
+65 SET SDARRAY("ADT")=$GET(SDARRAY("APPT DATE"))
+66 ;check in
SET ERR=$$CHECKIN(.SDARRAY)
+67 ; reset SDOUTPUT only if truly added one.
+68 IF 'ERR
SET VISIT=$$GETVST(SDARRAY("PAT"),SDARRAY("APPT DATE"))
IF VISIT
IF '$GET(SDARRAY("VIEN"))
if SDOUTPUT(0)=0
SET SDOUTPUT(0)=1
SET SDOUTPUT(VISIT)="ADD"
QUIT
+69 IF ERR
SET SDOUTPUT(0)=0_U_$PIECE(ERR,U,2)
End DoDot:1
QUIT
+70 ; else call walk-in (which calls make appt, checkin and create visit)
+71 DO WALKIN(.SDOUTPUT,.SDARRAY)
+72 QUIT
+73 ;
MATCH(SDOUT,SDINPUT) ; find matching visits based on input array
+1 SET SDOUT(0)=0
+2 NEW END,DATE,VIEN,STOP,DIFF,MATCH
+3 SET MATCH=0
+4 DO TIME(SDINPUT("TIME RANGE"),SDINPUT("VISIT DATE"),.DATE,.END)
+5 FOR
SET DATE=$ORDER(^AUPNVSIT("AA",SDINPUT("PAT"),DATE))
if 'DATE
QUIT
if (DATE>END)
QUIT
Begin DoDot:1
+6 SET VIEN=0
+7 FOR
SET VIEN=$ORDER(^AUPNVSIT("AA",SDINPUT("PAT"),DATE,VIEN))
if 'VIEN
QUIT
Begin DoDot:2
+8 ;check for delete flag just in case xref not killed
IF $$GET1^DIQ(9000010,VIEN,.11)="DELETED"
QUIT
+9 ;no match on loc of enc
IF SDINPUT("SITE")'=$$GET1^DIQ(9000010,VIEN,.06,"I")
QUIT
+10 ;no match on visit type
IF SDINPUT("VISIT TYPE")'=$$GET1^DIQ(9000010,VIEN,.03,"I")
QUIT
+11 ; get observation and day surgery visits
+12 ;don't look at HIM excluded visits
IF SDINPUT("SRV CAT")["CENRT"
QUIT
+13 ;don't look at HIM excluded visits
IF $$GET1^DIQ(90000010,VIEN,.07,"I")["CENRT"
QUIT
+14 ;no match on service category
IF SDINPUT("SRV CAT")=$$GET1^DIQ(9000010,VIEN,.07,"I")
SET MATCH=1
+15 ;match if observation
IF SDINPUT("SRV CAT")="A"
IF $GET(SDINPUT("ANCILLARY"))
IF $$GET1^DIQ(9000010,VIEN,.07,"I")="O"
SET MATCH=1
+16 IF SDINPUT("SRV CAT")="A"
IF $GET(SDINPUT("ANCILLARY"))
IF $$GET1^DIQ(9000010,VIEN,.07,"I")="D"
SET MATCH=1
+17 IF '$GET(MATCH)
QUIT
+18 ;check time range
IF SDINPUT("TIME RANGE")>-1
SET STOP=0
Begin DoDot:3
+19 ;find difference in minutes
SET DIFF=$$TIMEDIF(SDINPUT("VISIT DATE"),VIEN)
+20 IF $$ABS^XLFMTH(DIFF)>SDINPUT("TIME RANGE")
SET STOP=1
End DoDot:3
if STOP
QUIT
+21 ; if provider sent and didn't match, skip
IF '$$PRVMTCH(.SDINPUT,VIEN)
QUIT
+22 ; if called by ancillary, falls through and sets visit into array
+23 ; otherwise, check if app wants to match on clinic code or hosp location
+24 IF '$GET(SDINPUT("ANCILLARY"))
SET STOP=0
Begin DoDot:3
+25 IF $GET(SDINPUT("HOS LOC"))
IF '$GET(SDINPUT("CLINIC CODE"))
SET SDINPUT("CLINIC CODE")=$$GET1^DIQ(44,SDINPUT("HOS LOC"),8,"I")
+26 ;no match on clinic code
IF $GET(SDINPUT("CLINIC CODE"))
IF SDINPUT("CLINIC CODE")'=$$GET1^DIQ(9000010,VIEN,.08,"I")
SET STOP=1
QUIT
+27 ; if both have appt date and visit was triage clinic, is a match
+28 ; create visit on same day no matter what
+29 ;no match on hospital location
IF $GET(SDINPUT("HOS LOC"))
IF (SDINPUT("HOS LOC")'=$$GET1^DIQ(9000010,VIEN,.22,"I"))
SET STOP=1
QUIT
+30 ; if same clinic & same provider but not triage, make new visit
+31 IF $GET(SDINPUT("APPT DATE"))
IF $$GET1^DIQ(9000010,VIEN,.26,"I")
IF '$$TRIAGE(VIEN)
SET STOP=1
QUIT
End DoDot:3
if STOP
QUIT
+32 ; must be good match, increment counter and set array node
+33 SET SDOUT(0)=SDOUT(0)+1
+34 SET SDOUT(VIEN)=$$TIMEDIF(SDINPUT("VISIT DATE"),VIEN)
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
PRVMTCH(SDINPUT,VIEN) ; do visits match on provider?
+1 NEW PRVS,IEN
+2 ; if no provider sent, assume okay
IF '$GET(SDINPUT("PROVIDER"))
QUIT 1
+3 ; if visit is triage clinic & new encounter is not ancillary, skip provider match
+4 IF $$TRIAGE(VIEN)
IF '$GET(SDINPUT("ANCILLARY"))
QUIT 1
+5 ; find all v provider entries for visit
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVPRV("AD",VIEN,IEN))
if 'IEN
QUIT
Begin DoDot:1
+7 SET PRVS($$GET1^DIQ(9000010.06,IEN_",",.01,"I"))=""
End DoDot:1
+8 ; if incoming provider in list, this is match
+9 IF $DATA(PRVS(SDINPUT("PROVIDER")))
QUIT 1
+10 ; otherwise, no match
+11 QUIT 0
+12 ;
TIMEDIF(VDTTM,VIEN) ; return time diff between incoming time and current visit
+1 QUIT $$FMDIFF^XLFDT(VDTTM,+$GET(^AUPNVSIT(VIEN,0)),2)\60
+2 ;
ADDVIST(SDOUTPUT,SDARRAY) ;
+1 NEW %DT,SDVISITIN,SUB,X,Y
+2 SET SUB="SD"
FOR
SET SUB=$ORDER(SDARRAY(SUB))
if SUB=""
QUIT
if $EXTRACT(SUB,1,2)'="SD"
QUIT
SET SDVISITIN(SUB)=SDARRAY(SUB)
+3 ;keep it silent
SET SDVISITIN("AUPNTALK")=""
SET SDVISITIN("SDANE")=""
+4 ;facility
SET SDVISITIN("SDLOC")=$GET(SDARRAY("SITE"))
+5 ;patient
SET SDVISITIN("SDPAT")=$GET(SDARRAY("PAT"))
+6 ;visit type
SET SDVISITIN("SDTYPE")=$GET(SDARRAY("VISIT TYPE"))
+7 ;srv cat
SET SDVISITIN("SDCAT")=$GET(SDARRAY("SRV CAT"))
+8 ;chkin dt
SET SDVISITIN("SDDATE")=$GET(SDARRAY("VISIT DATE"))
+9 ;clinic code ien w/`
IF $GET(SDARRAY("CLINIC CODE"))
SET SDVISITIN("SDCLN")="`"_SDARRAY("CLINIC CODE")
+10 ;clinic name
SET SDVISITIN("SDHL")=$GET(SDARRAY("HOS LOC"))
+11 ;appt date
SET SDVISITIN("SDAPDT")=$GET(SDARRAY("APPT DATE"))
+12 SET SDVISITIN("SDUSR")=$GET(SDARRAY("USR"))
+13 ;force add
SET SDVISITIN("SDADD")=1
+14 ; create visit
+15 NEW SDVISITOUT
+16 DO EN1^SDES2CRTVISIT(.SDVISITOUT,.SDVISITIN)
+17 ; if no visit created,error quit
+18 IF '$GET(SDVISITOUT("SDVSIT"))
Begin DoDot:1
+19 SET SDOUTPUT(0)="0^Error Creating Visit"
End DoDot:1
QUIT
+20 ; set new visit info in out array
+21 SET SDOUTPUT(SDVISITOUT("SDVSIT"))="ADD"
SET SDOUTPUT(0)=1
+22 KILL SDVISITIN,SDVISITOUT
+23 QUIT
+24 ;
WALKIN(SDOUT,SDWALKIN) ;Create walkin appt which is checked in and visit created
+1 NEW ERR,VISIT
+2 ;initialize outgoing count
SET SDOUT(0)=0
+3 SET SDWALKIN("CLN")=$GET(SDWALKIN("HOS LOC"))
+4 ;4=walkin
SET SDWALKIN("TYP")=4
+5 SET SDWALKIN("ADT")=$GET(SDWALKIN("APPT DATE"))
+6 IF '$DATA(SDWALKIN("LEN"))
SET SDWALKIN("LEN")=$$GET1^DIQ(44,SDWALKIN("CLN"),1912)
+7 ; make walkin appt
+8 SET ERR=$$MAKE(.SDWALKIN)
IF ERR
SET $PIECE(SDOUT(0),U,2)=$PIECE(ERR,U,2)
QUIT
+9 ; set variables used by checkin call
+10 SET SDWALKIN("CDT")=SDWALKIN("VISIT DATE")
+11 SET SDWALKIN("CC")=$GET(SDWALKIN("CLINIC CODE"))
+12 SET SDWALKIN("PRV")=$GET(SDWALKIN("PROVIDER"))
+13 ; check in appt and create visit
+14 SET ERR=$$CHECKIN(.SDWALKIN)
+15 ; update out array based on result
+16 ; reset SDOUTPUT(0) only if added new visit
+17 ;visit added
IF 'ERR
SET VISIT=$$GETVST(SDWALKIN("PAT"),SDWALKIN("APPT DATE"))
IF VISIT
IF '$GET(SDARRAY("VIEN"))
if SDOUT(0)=0
SET SDOUT(0)=1
SET SDOUT(VISIT)="ADD"
+18 ;error
IF ERR
SET $PIECE(SDOUT(0),U,2)=$PIECE(ERR,U,2)
+19 QUIT
+20 ;
HAVEREQ(SDOUT,SDINPUT) ; check required fields
+1 IF '$GET(SDINPUT("FORCE ADD"))
IF '$DATA(SDINPUT("TIME RANGE"))
SET SDOUT(0)="0^Missing Time Range"
QUIT 0
+2 IF '$DATA(SDINPUT("PAT"))
SET SDOUT(0)="0^Missing Patient IEN"
QUIT 0
+3 IF '$DATA(SDINPUT("VISIT DATE"))
SET SDOUT(0)="0^Missing Visit Date"
QUIT 0
+4 IF '$DATA(SDINPUT("SITE"))
SET SDOUT(0)="0^Missing Facility/Site"
QUIT 0
+5 IF '$DATA(SDINPUT("VISIT TYPE"))
SET SDOUT(0)="0^Missing Visit Type"
QUIT 0
+6 IF '$DATA(SDINPUT("SRV CAT"))
SET SDOUT(0)="0^Missing Service Category"
QUIT 0
+7 IF '$DATA(SDINPUT("USR"))
SET SDOUT(0)="0^Missing User IEN"
QUIT 0
+8 IF $GET(SDINPUT("HOS LOC"))
IF '$GET(SDINPUT("CLINIC CODE"))
SET SDINPUT("CLINIC CODE")=$$GET1^DIQ(44,SDINPUT("HOS LOC"),8,"I")
+9 ; convert service category
+10 IF $GET(SDINPUT("APPT DATE"))
IF $GET(SDINPUT("HOS LOC"))
SET SDINPUT("SRV CAT")=$$SERCAT(SDINPUT("HOS LOC"),SDINPUT("PAT"))
+11 QUIT 1
+12 ;
TIME(RANGE,VISIT,DATE,END) ; set DATE and END based on TIME RANGE setting in minutes
+1 NEW TMDIF,SW
+2 SET TMDIF=$SELECT(RANGE<1:0,1:RANGE)
+3 SET DATE=$$FMADD^XLFDT(VISIT,,,-TMDIF)
+4 SET END=$$FMADD^XLFDT(VISIT,,,TMDIF)
+5 IF (DATE\1)<(END\1)
SET SW=(END\1)
SET END=(DATE\1)_".9999"
SET DATE=SW
+6 SET DATE=(9999999-(DATE\1)_"."_$PIECE(DATE,".",2))-.0001
+7 SET END=9999999-(END\1)_"."_$PIECE(END,".",2)
+8 ;no time range used
IF RANGE=-1
SET END=(END\1)_".9999"
SET DATE=(DATE\1)
+9 QUIT
+10 ;
TRIAGE(VST) ; returns 1 if visit's hosp loc is triage type
+1 NEW HSPLOC
+2 SET HSPLOC=$$GET1^DIQ(9000010,VST,.22,"I")
IF 'HSPLOC
QUIT 0
+3 QUIT +$$GET1^DIQ(9009017.2,HSPLOC,.16,"I")
+4 ;
MAKE(SDAPPTIN) ;Call to store appt made
+1 ;
+2 ; Make call using: S ERR=$$MAKE^SDES2GETVISIT(.ARRAY)
+3 ;
+4 ; Input Array -
+5 ; SDAPPTIN("PAT") = ien of patient in file 2
+6 ; SDAPPTIN("CLN") = ien of clinic in file 44
+7 ; SDAPPTIN("TYP") = 3 for scheduled appts, 4 for walkins
+8 ; SDAPPTIN("ADT") = appointment date and time
+9 ; SDAPPTIN("LEN") = appointment length in minutes (5-240)
+10 ; SDAPPTIN("OI") = reason for appt - up to 150 characters
+11 ; SDAPPTIN("USR") = user who made appt
+12 ;
+13 ; Output: error status and message
+14 ; = 0 or null: everything okay
+15 ; = 1^message: error and reason
+16 ;
+17 NEW SDERROR
+18 IF '$DATA(^DPT(+$GET(SDAPPTIN("PAT")),0))
QUIT 1_U_"Patient not on file: "_$GET(SDAPPTIN("PAT"))
+19 IF '$DATA(^SC(+$GET(SDAPPTIN("CLN")),0))
QUIT 1_U_"Clinic not on file: "_$GET(SDAPPTIN("CLN"))
+20 IF ($GET(SDAPPTIN("TYP"))<3)!($GET(SDAPPTIN("TYP"))>4)
QUIT 1_U_"Appt Type error: "_$GET(SDAPPTIN("TYP"))
+21 ;PWC allow any time combination of numbers #694
IF $GET(SDAPPTIN("ADT"))'?7N1"."1N.N
QUIT 1_U_"Appt Date/Time error: "_$GET(SDAPPTIN("ADT"))
+22 IF ($GET(SDAPPTIN("LEN"))<5)!($GET(SDAPPTIN("LEN"))>240)
QUIT 1_U_"Appt Length error: "_$GET(SDAPPTIN("LEN"))
+23 IF '$DATA(^VA(200,+$GET(SDAPPTIN("USR")),0))
QUIT 1_U_"User Who Made Appt Error: "_$GET(SDAPPTIN("USR"))
+24 IF $DATA(^DPT(SDAPPTIN("PAT"),"S",SDAPPTIN("ADT"),0))
IF $$GET1^DIQ(2.98,SDAPPTIN("ADT")_","_SDAPPTIN("PAT")_",",3,"I")'="C"
QUIT 1_U_"Patient "_SDAPPTIN("PAT")_" already has appt at "_SDAPPTIN("ADT")
+25 ;
+26 NEW DIC,DA,Y,X,DD,DO,DLAYGO
+27 IF $DATA(^DPT(SDAPPTIN("PAT"),"S",SDAPPTIN("ADT"),0))
IF $$GET1^DIQ(2.98,SDAPPTIN("ADT")_","_SDAPPTIN("PAT")_",",3,"I")="C"
Begin DoDot:1
+28 ; "un-cancel" existing appt in file 2
+29 NEW SDAPPTFDA,SDAPPTIENS,SDAPPTERR
+30 SET SDAPPTIENS=SDAPPTIN("ADT")_","_SDAPPTIN("PAT")_","
+31 SET SDAPPTFDA(2.98,SDAPPTIENS,".01")=SDAPPTIN("CLN")
+32 SET SDAPPTFDA(2.98,SDAPPTIENS,"3")=""
+33 SET SDAPPTFDA(2.98,SDAPPTIENS,"9")=SDAPPTIN("TYP")
+34 SET SDAPPTFDA(2.98,SDAPPTIENS,"9.5")=9
+35 SET SDAPPTFDA(2.98,SDAPPTIENS,"14")=""
+36 SET SDAPPTFDA(2.98,SDAPPTIENS,"15")=""
+37 SET SDAPPTFDA(2.98,SDAPPTIENS,"16")=""
+38 SET SDAPPTFDA(2.98,SDAPPTIENS,"19")=""
+39 SET SDAPPTFDA(2.98,SDAPPTIENS,"20")=$$NOW^XLFDT
+40 DO FILE^DIE("","SDAPPTFDA","SDAPPTERR")
+41 NEW SDAPPTTMP
SET SDAPPTTMP=$GET(SDAPPTERR)
End DoDot:1
+42 IF '$TEST
Begin DoDot:1
+43 ; add appt to file 2
+44 ; call to silent server call
+45 NEW SDAPPTFDA,SDAPPTIENS,SDAPPTERR
+46 SET SDAPPTIENS="?+2,"_SDAPPTIN("PAT")_","
+47 SET SDAPPTIENS(2)=SDAPPTIN("ADT")
+48 SET SDAPPTFDA(2.98,SDAPPTIENS,.01)=SDAPPTIN("CLN")
+49 SET SDAPPTFDA(2.98,SDAPPTIENS,"9")=SDAPPTIN("TYP")
+50 SET SDAPPTFDA(2.98,SDAPPTIENS,"9.5")=9
+51 SET SDAPPTFDA(2.98,SDAPPTIENS,"20")=$$NOW^XLFDT
+52 DO UPDATE^DIE("","SDAPPTFDA","SDAPPTIENS","SDERROR(1)")
End DoDot:1
IF $GET(SDERROR(1))
QUIT 1_U_"FileMan add to DPT error: Patient="_SDAPPTIN("PAT")_" Appt="_SDAPPTIN("ADT")
+53 ;
+54 ; add appt to file 44
+55 KILL DIC,DA,X,Y,DLAYGO,DD,DO
+56 IF '$DATA(^SC(SDAPPTIN("CLN"),"S",0))
SET ^SC(SDAPPTIN("CLN"),"S",0)="^44.001DA^^"
+57 IF '$DATA(^SC(SDAPPTIN("CLN"),"S",SDAPPTIN("ADT"),0))
Begin DoDot:1
+58 SET DIC="^SC("_SDAPPTIN("CLN")_",""S"","
SET DA(1)=SDAPPTIN("CLN")
SET (X,DINUM)=SDAPPTIN("ADT")
+59 SET DIC("P")="44.001DA"
SET DIC(0)="L"
SET DLAYGO=44.001
+60 SET Y=1
IF '$DATA(@(DIC_X_")"))
DO FILE^DICN
End DoDot:1
IF Y<1
QUIT 1_U_"Error adding date to file 44: Clinic="_SDAPPTIN("CLN")_" Date="_SDAPPTIN("ADT")
+61 ;
+62 KILL DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
+63 SET DIC="^SC("_SDAPPTIN("CLN")_",""S"","_SDAPPTIN("ADT")_",1,"
+64 SET DA(2)=SDAPPTIN("CLN")
SET DA(1)=SDAPPTIN("ADT")
SET X=SDAPPTIN("PAT")
+65 SET DIC("DR")="1///"_SDAPPTIN("LEN")_";3///"_$EXTRACT($GET(SDAPPTIN("OI")),1,150)_";7///"_SDAPPTIN("USR")_";8///"_$$NOW^XLFDT
+66 SET DIC("P")="44.003PA"
SET DIC(0)="L"
SET DLAYGO=44.003
+67 DO FILE^DICN
+68 ;
+69 ; call event driver
+70 NEW DFN,SDT,SDCL,SDDA,SDMODE
+71 SET DFN=SDAPPTIN("PAT")
SET SDT=SDAPPTIN("ADT")
SET SDCL=SDAPPTIN("CLN")
SET SDMODE=2
+72 SET SDDA=$$SCIEN(SDAPPTIN("PAT"),SDAPPTIN("CLN"),SDAPPTIN("ADT"))
+73 DO MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
+74 QUIT 0
+75 ;
CHECKIN(SDAPPTIN) ;Call to add checkin info to appt
+1 ;
+2 ; Input array -
+3 ; SDAPPTIN("PAT") = ien of patient in file 2
+4 ; SDAPPTIN("CLN") = ien of clinic in file 44
+5 ; SDAPPTIN("ADT") = appt date/time
+6 ; SDAPPTIN("CDT") = checkin date/time
+7 ; SDAPPTIN("USR") = checkin user
+8 ; SDAPPTIN("OPT") = option used to create visit (optional)
+9 ; SDAPPTIN("VIEN") = visit IEN (sent if new visit is NOT to be created)
+10 ;
+11 ; variables to create visit under event driver
+12 ; SDAPPTIN("CC") = clinic code for creating visit - optional
+13 ; SDAPPTIN("PRV") = visit provider - pointer to file 200
+14 ;
+15 ; Output value = 0 (successful)
+16 ; = 1^error message
+17 ;
+18 IF '$DATA(^DPT(+$GET(SDAPPTIN("PAT")),0))
QUIT 1_U_"Patient not on file: "_$GET(SDAPPTIN("PAT"))
+19 IF '$DATA(^SC(+$GET(SDAPPTIN("CLN")),0))
QUIT 1_U_"Clinic not on file: "_$GET(SDAPPTIN("CLN"))
+20 IF $GET(SDAPPTIN("ADT"))'?7N1"."1N.N
QUIT 1_U_"Appt Date/Time error: "_$GET(SDAPPTIN("ADT"))
+21 IF $GET(SDAPPTIN("CDT"))'?7N1"."1N.N
QUIT 1_U_"Checkin Date/Time error: "_$GET(SDAPPTIN("CDT"))
+22 IF '$DATA(^VA(200,+$GET(SDAPPTIN("USR")),0))
QUIT 1_U_"User Who Made Appt Error: "_$GET(SDAPPTIN("USR"))
+23 ;
+24 ; find ien for appt in file 44
+25 NEW IEN,DIE,DA,DR,SDVSTN
+26 SET IEN=$$SCIEN(SDAPPTIN("PAT"),SDAPPTIN("CLN"),SDAPPTIN("ADT"))
+27 IF 'IEN
QUIT 1_U_"Error trying to find appointment for checkin: Patient="_SDAPPTIN("PAT")_" Clinic="_SDAPPTIN("CLN")_" Appt="_SDAPPTIN("ADT")
+28 ;
+29 ; remember before status
+30 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
+31 SET DFN=SDAPPTIN("PAT")
SET SDT=SDAPPTIN("ADT")
SET SDCL=SDAPPTIN("CLN")
SET SDMODE=2
SET SDDA=IEN
+32 SET SDCIHDL=$$HANDLE^SDAMEVT(1)
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+33 DO BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+34 ;
+35 ; set checkin
+36 NEW SDFDA
+37 SET SDFDA(44.003,IEN_","_SDAPPTIN("ADT")_","_SDAPPTIN("CLN")_",",305)=$$NOW^XLFDT()
+38 SET SDFDA(44.003,IEN_","_SDAPPTIN("ADT")_","_SDAPPTIN("CLN")_",",309)=SDAPPTIN("CDT")
+39 DO FILE^DIE("","SDFDA")
+40 KILL SDFDA
+41 ; Updating 302 separately because of trigger on field 309 uses logged-in DUZ
+42 SET SDFDA(44.003,IEN_","_SDAPPTIN("ADT")_","_SDAPPTIN("CLN")_",",302)=SDAPPTIN("USR")
+43 DO FILE^DIE("","SDFDA")
+44 ;
+45 ; set after status
+46 SET SDDA=$$SCIEN(SDAPPTIN("PAT"),SDAPPTIN("CLN"),SDAPPTIN("ADT"))
+47 SET SDCIHDL=$$HANDLE^SDAMEVT(1)
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+48 DO AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+49 ;
+50 QUIT 0
+51 ;
SERCAT(CLINIC,PAT) ;Returns service category for visit
+1 NEW CLNCAT
+2 ;in hospital if inpt
IF $$GET1^DIQ(2,PAT_",",.1)]""
QUIT "I"
+3 ;clinic's service category
SET CLNCAT=$$GET1^DIQ(9009017.2,CLINIC,.12,"I")
+4 QUIT $SELECT(CLNCAT]"":CLNCAT,1:"A")
+5 ;
SCIEN(PAT,CLINIC,DATE) ;Returns ien for appt in ^SC
+1 NEW APPTIEN,VALIDIEN
+2 SET APPTIEN=0
FOR
SET APPTIEN=$ORDER(^SC(CLINIC,"S",DATE,1,APPTIEN))
if 'APPTIEN
QUIT
if $GET(VALIDIEN)
QUIT
Begin DoDot:1
+3 ;cancelled
if $$GET1^DIQ(44.003,APPTIEN_","_DATE_","_CLINIC,310,"I")="C"
QUIT
+4 IF $$GET1^DIQ(44.003,APPTIEN_","_DATE_","_CLINIC,.01,"I")=PAT
SET VALIDIEN=APPTIEN
End DoDot:1
+5 QUIT $GET(VALIDIEN)
+6 ;
GETVST(PAT,DATE) ;Returns visit ien for appt date and patient
+1 IF ('PAT)!('DATE)
QUIT 0
+2 NEW OUTPTENC
+3 SET OUTPTENC=$$GET1^DIQ(2.98,DATE_","_PAT_",",21,"I")
+4 ;outpt encounter ptr
IF 'OUTPTENC
QUIT 0
+5 ;
+6 ;patient ptr
IF $$GET1^DIQ(409.68,OUTPTENC_",",.02,"I")'=PAT
QUIT 0
+7 ;visit ptr
QUIT $$GET1^DIQ(409.68,OUTPTENC_",",.05,"I")
+8 ;
