SDEC25B.m

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 ---SDEC25B   3402     printed  Feb 19, 2025@00:16:46                                                                                                                                                                                                     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