SDEC25B ;ALB/SAT - VISTA SCHEDULING RPCS ;Apr 03, 2020@14:27
;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
;
Q
;
CO(SDOE,DFN,SDT,SDCL,SDCODT,SDECAPTID,SDQUIET,VPRV,APIERR) ;EP; called to ask check-out date/time ;SAT ADDED PARAMETERS SDCODT, SDECAPTID, & SDQUIET
; Called by SDCO1
; SDOE = Outpatient Encounter IEN
; DFN = Patient IEN
; SDT = Appointment Date/Time
; SDCL = Clinic IEN
; SDCODT = APPOINTMENT CHECKOUT TIME [OPTIONAL - USED WHEN SDQUIET=1] USER ENTERED FORMAT
; SDECAPTID = APPOINTMENT ID - POINTER TO ^SDECAPPT
; SDQUIET = ALLOW NO TERMINAL INPUT/OUTPUT 0=ALLOW; 1=DO NOT ALLOW
; VPRV = V Provider IEN - pointer to V PROVIDER file
; APIERR = Returned Array of errors
; APIERR = counter
; APIERR(counter)=message -- <Prog name>: <message>
;
I '$G(SDOE) D ^%ZTER Q ;lets trap an error here to see what is causing the problem
N DIE,DA,DR,SDECNOD,SDN,SDV,AUPNVSIT
S DIE="^SC("_SDCL_",""S"","_SDT_",1,"
S DA(2)=SDCL,DA(1)=SDT,(DA,SDN)=$$SCIEN^SDECU2(DFN,SDCL,SDT)
;S DA(4)=SDCL,DA(3)="S",DA(2)=SDT,DA(1)=1,(DA,SDN)=$$SCIEN^SDECU2(DFN,SDCL,SDT)
;CHECK THAT APPOINTMENT IS CHECKED IN
I $P($G(^SC(+SDCL,"S",SDT,1,SDN,"C")),U)="" D Q
. S APIERR=$G(APIERR)+1 S APIERR(APIERR)="SDEC25B: Patient not checked in"
. Q
;
S DR="303///"_SDCODT_";304///`"_DUZ_";306///"_$$NOW^XLFDT ;PWC removed the $$FMTE^XLFDT for variable SDCODT SD*5.3*694
D ^DIE
;
; if checked out and status not updated, do it now
I $P($G(^SC(+SDCL,"S",SDT,1,DA,"C")),U,3)]"" D
. ;UPDATE APPOINTMENT SCHEDULE GLOBAL ^SDEC(409.84
. I $G(SDECAPTID) D
. . S PSTAT=$P(^SCE(SDOE,0),U,12)
. . S DIE="^SDEC(409.84,"
. . S DA=SDECAPTID
. . S DR=".14///"_$G(SDCODT)_";.19///"_PSTAT
. . D ^DIE
. . ;possibly update VProvider
. . S SDECNOD=^SDEC(409.84,SDECAPTID,0)
. . I $G(VPRV),+$P(SDECNOD,U,15) D
. . . ;get SDEC appointment schedule
. . . S DIE="^AUPNVPRV("
. . . S DA=$P(SDECNOD,U,15)
. . . S DR=".01///"_VPRV
. . . D ^DIE
. ;
. Q:$$GET1^DIQ(409.68,SDOE,.12)="CHECKED OUT"
. S DIE=409.68,DA=SDOE,DR=".12///14;101///"_DUZ_";102///"_$$NOW^XLFDT
. D ^DIE
. ;
. ; if visit pointer stored, update visit checkout date/time
. S SDV=$$GET1^DIQ(409.68,SDOE,.05,"I") Q:'SDV
. Q:'$D(^AUPNVSIT(SDV,0)) Q:$$GET1^DIQ(9000010,SDV,.05,"I")'=DFN
. Q:$$GET1^DIQ(9000010,SDV,.11,"I")=1 ;deleted
. ;
. ;cmi/maw 5/1/2009 PATCH 1010 RQMT 34
. S DIE="^AUPNVSIT(",DA=SDV
. S DR=".18///"_$P($G(^SC(+SDCL,"S",SDT,1,SDN,"C")),U,3)
. D ^DIE
Q
;
CO1(SDECAPTID,SDCODT,SDOE,VPRV) ;external checkout called from FILE^SDAPIAP to update SDEC APPOINTMENT from VistA appointment check out
;INPUT:
; SDECAPTID = Appt ID pointer to SDEC APPOINTMENT file
; SDCODT = Checkout date/time in fm format
; SDOE = outpatient encounter pointer to OUTPATIENT ENCOUNTER file 409.68
; VPRV = V Provider pointer to V PROVIDER file
N DA,DR,PSTAT,SDEDNOD
I $G(SDECAPTID) D
. S PSTAT=$P(^SCE(SDOE,0),U,12)
. S DIE="^SDEC(409.84,"
. S DA=SDECAPTID
. S DR=".14///"_$G(SDCODT)_";.19///"_PSTAT
. D ^DIE
. ;possibly update VProvider
. S SDECNOD=^SDEC(409.84,SDECAPTID,0)
. I $G(VPRV),+$P(SDECNOD,U,15) D
. . ;get SDEC appointment schedule
. . S DIE="^AUPNVPRV("
. . S DA=$P(SDECNOD,U,15)
. . S DR=".01///"_VPRV
. . D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC25B 3402 printed Apr 09, 2024@22:01:21 Page 2
SDEC25B ;ALB/SAT - VISTA SCHEDULING RPCS ;Apr 03, 2020@14:27
+1 ;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
+2 ;
+3 QUIT
+4 ;
CO(SDOE,DFN,SDT,SDCL,SDCODT,SDECAPTID,SDQUIET,VPRV,APIERR) ;EP; called to ask check-out date/time ;SAT ADDED PARAMETERS SDCODT, SDECAPTID, & SDQUIET
+1 ; Called by SDCO1
+2 ; SDOE = Outpatient Encounter IEN
+3 ; DFN = Patient IEN
+4 ; SDT = Appointment Date/Time
+5 ; SDCL = Clinic IEN
+6 ; SDCODT = APPOINTMENT CHECKOUT TIME [OPTIONAL - USED WHEN SDQUIET=1] USER ENTERED FORMAT
+7 ; SDECAPTID = APPOINTMENT ID - POINTER TO ^SDECAPPT
+8 ; SDQUIET = ALLOW NO TERMINAL INPUT/OUTPUT 0=ALLOW; 1=DO NOT ALLOW
+9 ; VPRV = V Provider IEN - pointer to V PROVIDER file
+10 ; APIERR = Returned Array of errors
+11 ; APIERR = counter
+12 ; APIERR(counter)=message -- <Prog name>: <message>
+13 ;
+14 ;lets trap an error here to see what is causing the problem
IF '$GET(SDOE)
DO ^%ZTER
QUIT
+15 NEW DIE,DA,DR,SDECNOD,SDN,SDV,AUPNVSIT
+16 SET DIE="^SC("_SDCL_",""S"","_SDT_",1,"
+17 SET DA(2)=SDCL
SET DA(1)=SDT
SET (DA,SDN)=$$SCIEN^SDECU2(DFN,SDCL,SDT)
+18 ;S DA(4)=SDCL,DA(3)="S",DA(2)=SDT,DA(1)=1,(DA,SDN)=$$SCIEN^SDECU2(DFN,SDCL,SDT)
+19 ;CHECK THAT APPOINTMENT IS CHECKED IN
+20 IF $PIECE($GET(^SC(+SDCL,"S",SDT,1,SDN,"C")),U)=""
Begin DoDot:1
+21 SET APIERR=$GET(APIERR)+1
SET APIERR(APIERR)="SDEC25B: Patient not checked in"
+22 QUIT
End DoDot:1
QUIT
+23 ;
+24 ;PWC removed the $$FMTE^XLFDT for variable SDCODT SD*5.3*694
SET DR="303///"_SDCODT_";304///`"_DUZ_";306///"_$$NOW^XLFDT
+25 DO ^DIE
+26 ;
+27 ; if checked out and status not updated, do it now
+28 IF $PIECE($GET(^SC(+SDCL,"S",SDT,1,DA,"C")),U,3)]""
Begin DoDot:1
+29 ;UPDATE APPOINTMENT SCHEDULE GLOBAL ^SDEC(409.84
+30 IF $GET(SDECAPTID)
Begin DoDot:2
+31 SET PSTAT=$PIECE(^SCE(SDOE,0),U,12)
+32 SET DIE="^SDEC(409.84,"
+33 SET DA=SDECAPTID
+34 SET DR=".14///"_$GET(SDCODT)_";.19///"_PSTAT
+35 DO ^DIE
+36 ;possibly update VProvider
+37 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+38 IF $GET(VPRV)
IF +$PIECE(SDECNOD,U,15)
Begin DoDot:3
+39 ;get SDEC appointment schedule
+40 SET DIE="^AUPNVPRV("
+41 SET DA=$PIECE(SDECNOD,U,15)
+42 SET DR=".01///"_VPRV
+43 DO ^DIE
End DoDot:3
End DoDot:2
+44 ;
+45 if $$GET1^DIQ(409.68,SDOE,.12)="CHECKED OUT"
QUIT
+46 SET DIE=409.68
SET DA=SDOE
SET DR=".12///14;101///"_DUZ_";102///"_$$NOW^XLFDT
+47 DO ^DIE
+48 ;
+49 ; if visit pointer stored, update visit checkout date/time
+50 SET SDV=$$GET1^DIQ(409.68,SDOE,.05,"I")
if 'SDV
QUIT
+51 if '$DATA(^AUPNVSIT(SDV,0))
QUIT
if $$GET1^DIQ(9000010,SDV,.05,"I")'=DFN
QUIT
+52 ;deleted
if $$GET1^DIQ(9000010,SDV,.11,"I")=1
QUIT
+53 ;
+54 ;cmi/maw 5/1/2009 PATCH 1010 RQMT 34
+55 SET DIE="^AUPNVSIT("
SET DA=SDV
+56 SET DR=".18///"_$PIECE($GET(^SC(+SDCL,"S",SDT,1,SDN,"C")),U,3)
+57 DO ^DIE
End DoDot:1
+58 QUIT
+59 ;
CO1(SDECAPTID,SDCODT,SDOE,VPRV) ;external checkout called from FILE^SDAPIAP to update SDEC APPOINTMENT from VistA appointment check out
+1 ;INPUT:
+2 ; SDECAPTID = Appt ID pointer to SDEC APPOINTMENT file
+3 ; SDCODT = Checkout date/time in fm format
+4 ; SDOE = outpatient encounter pointer to OUTPATIENT ENCOUNTER file 409.68
+5 ; VPRV = V Provider pointer to V PROVIDER file
+6 NEW DA,DR,PSTAT,SDEDNOD
+7 IF $GET(SDECAPTID)
Begin DoDot:1
+8 SET PSTAT=$PIECE(^SCE(SDOE,0),U,12)
+9 SET DIE="^SDEC(409.84,"
+10 SET DA=SDECAPTID
+11 SET DR=".14///"_$GET(SDCODT)_";.19///"_PSTAT
+12 DO ^DIE
+13 ;possibly update VProvider
+14 SET SDECNOD=^SDEC(409.84,SDECAPTID,0)
+15 IF $GET(VPRV)
IF +$PIECE(SDECNOD,U,15)
Begin DoDot:2
+16 ;get SDEC appointment schedule
+17 SET DIE="^AUPNVPRV("
+18 SET DA=$PIECE(SDECNOD,U,15)
+19 SET DR=".01///"_VPRV
+20 DO ^DIE
End DoDot:2
End DoDot:1
+21 QUIT
