BSDX25A.m

BSDX25A ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

 ;

CO(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOACT,SDLNE,SDCOALBF,BSDXAPTID,SDQUIET,VPRV,APIERR) ;Appt Check Out

 ; Input  -- DFN      Patient file IEN

 ;           SDT      Appointment Date/Time

 ;           SDCL     Hospital Location file IEN for Appt

 ;           SDDA     IEN in ^SC multiple or null [Optional]

 ;           SDASK    Ask Check Out Date/Time     [Optional]

 ;           SDCODT   Date/Time of Check Out      [Optional]

 ;           SDCOACT  Appt Mgmt Check Out Action  [Optional]

 ;           SDLNE    Appt Mgmt Line Number       [Optional]

 ; Output -- SDCOALBF Re-build Appt Mgmt List

 ; Input  -- BSDXAPTID Appointment ID

 ;           SDQUIET  No Terminal output 0=allow display 1=do not allow

 ;           VPRV     V Provider IEN - pointer to V PROVIDER file

 I $D(XRTL) D T0^%ZOSV

 N SDCOQUIT,SDOE,SDATA

 S:'SDDA SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)

 I 'SDDA D  Q  ; RETURN ERROR IF SDQUIET

 . S APIERR($I(APIERR))="SDCO1: Cannot check out this appointment - Hospital Location not identified."

 . G COQ

 S SDATA=$G(^DPT(DFN,"S",SDT,0))

 ; ** MT Blocking removed

 ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T,$G(EASACT)'="W",$$MT^EASMTCHK(DFN,$P($G(SDATA),U,16),"C",$G(SDT)) D PAUSE^VALM1 G COQ

 ;

 ;-- if new encounter, pass to PCE

 I $$NEW^SDPCE(SDT) D  S VALMBCK="R",SDCOALBF=1 G COQ

 . N SDCOED

 . S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)

 . ;

 . ; -- has appt already been checked out

 . S SDCOED=$$CHK($TR($$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA),";","^"))

 . ;

 . D CO^BSDX25B(SDOE,DFN,SDT,SDCL,SDCODT,BSDXAPTID,SDQUIET,VPRV,.APIERR) Q

 ;

COQ K % Q

 ;

 ;

 ;

CHK(SDSTB) ; -- is appointment checked out

 N Y

 I "^2^8^12^"[("^"_+SDSTB_"^"),$P(SDSTB,"^",3)["CHECKED OUT" S Y=1

 Q +$G(Y)

 ;

DT(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOQUIT) ;Update Check Out Date

 N %DT,DR,SDCIDT,X

 S:'$D(^SC(SDCL,"S",0)) ^(0)="^44.001DA^^"

 S DR="",SDCIDT=$P($G(^SC(SDCL,"S",SDT,1,SDDA,"C")),"^"),X=$P($G(^("C")),"^",3)

 I X G DTQ:'SDASK  S DR="303R"

 I DR="",$P(^SC(SDCL,0),U,24),$$REQ^SDM1A(SDT)="CO" S DR="303R//"_$S($G(SDCODT):$$FTIME^VALM1($S(SDCODT<SDCIDT:SDCIDT,1:SDCODT)),1:"NOW")

 I DR="" S DR="303R///"_$S($G(SDCODT):"/"_$S(SDCODT<SDCIDT:SDCIDT,1:SDCODT),1:"NOW")

 S DR="S SDCOQUIT="""";"_DR_";K SDCOQUIT"

 D DIE(SDCL,SDT,SDDA,DR)

DTQ Q

 ;

DIE(SDCL,SDT,SDDA,DR) ; -- update appt data in ^SC

 N DA,DIE

 S DA(2)=SDCL,DA(1)=SDT,DA=SDDA,DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,"

 D ^DIE K DQ,DE

DIEQ Q

BSDX25A   ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 +1       ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

 +2       ;

CO(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOACT,SDLNE,SDCOALBF,BSDXAPTID,SDQUIET,VPRV,APIERR) ;Appt Check Out

 +1       ; Input  -- DFN      Patient file IEN

 +2       ;           SDT      Appointment Date/Time

 +3       ;           SDCL     Hospital Location file IEN for Appt

 +4       ;           SDDA     IEN in ^SC multiple or null [Optional]

 +5       ;           SDASK    Ask Check Out Date/Time     [Optional]

 +6       ;           SDCODT   Date/Time of Check Out      [Optional]

 +7       ;           SDCOACT  Appt Mgmt Check Out Action  [Optional]

 +8       ;           SDLNE    Appt Mgmt Line Number       [Optional]

 +9       ; Output -- SDCOALBF Re-build Appt Mgmt List

 +10      ; Input  -- BSDXAPTID Appointment ID

 +11      ;           SDQUIET  No Terminal output 0=allow display 1=do not allow

 +12      ;           VPRV     V Provider IEN - pointer to V PROVIDER file

 +13       IF $DATA(XRTL)

               DO T0^%ZOSV

 +14       NEW SDCOQUIT,SDOE,SDATA

 +15       IF 'SDDA

               SET SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)

 +16      ; RETURN ERROR IF SDQUIET

           IF 'SDDA

               Begin DoDot:1

 +17 

*** ERROR ***

                   SET APIERR($I(APIERR))="SDCO1: Cannot check out this appointment - Hospital Location not identified."

 +18               GOTO COQ

               End DoDot:1

               QUIT 

 +19       SET SDATA=$GET(^DPT(DFN,"S",SDT,0))

 +20      ; ** MT Blocking removed

 +21      ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T,$G(EASACT)'="W",$$MT^EASMTCHK(DFN,$P($G(SDATA),U,16),"C",$G(SDT)) D PAUSE^VALM1 G COQ

 +22      ;

 +23      ;-- if new encounter, pass to PCE

 +24       IF $$NEW^SDPCE(SDT)

               Begin DoDot:1

 +25               NEW SDCOED

 +26               SET SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)

 +27      ;

 +28      ; -- has appt already been checked out

 +29               SET SDCOED=$$CHK($TRANSLATE($$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA),";","^"))

 +30      ;

 +31               DO CO^BSDX25B(SDOE,DFN,SDT,SDCL,SDCODT,BSDXAPTID,SDQUIET,VPRV,.APIERR)

                   QUIT 

               End DoDot:1

               SET VALMBCK="R"

               SET SDCOALBF=1

               GOTO COQ

 +32      ;

COQ        KILL %

           QUIT 

 +1       ;

 +2       ;

 +3       ;

CHK(SDSTB) ; -- is appointment checked out

 +1        NEW Y

 +2        IF "^2^8^12^"[("^"_+SDSTB_"^")

               IF $PIECE(SDSTB,"^",3)["CHECKED OUT"

                   SET Y=1

 +3        QUIT +$GET(Y)

 +4       ;

DT(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOQUIT) ;Update Check Out Date

 +1        NEW %DT,DR,SDCIDT,X

 +2        IF '$DATA(^SC(SDCL,"S",0))

               SET ^(0)="^44.001DA^^"

 +3        SET DR=""

           SET SDCIDT=$PIECE($GET(^SC(SDCL,"S",SDT,1,SDDA,"C")),"^")

           SET X=$PIECE($GET(^("C")),"^",3)

 +4        IF X

               IF 'SDASK

                   GOTO DTQ

               SET DR="303R"

 +5        IF DR=""

               IF $PIECE(^SC(SDCL,0),U,24)

                   IF $$REQ^SDM1A(SDT)="CO"

                       SET DR="303R//"_$SELECT($GET(SDCODT):$$FTIME^VALM1($SELECT(SDCODT<SDCIDT:SDCIDT,1:SDCODT)),1:"NOW")

 +6        IF DR=""

               SET DR="303R///"_$SELECT($GET(SDCODT):"/"_$SELECT(SDCODT<SDCIDT:SDCIDT,1:SDCODT),1:"NOW")

 +7        SET DR="S SDCOQUIT="""";"_DR_";K SDCOQUIT"

 +8        DO DIE(SDCL,SDT,SDDA,DR)

DTQ        QUIT 

 +1       ;

DIE(SDCL,SDT,SDDA,DR) ; -- update appt data in ^SC

 +1        NEW DA,DIE

 +2        SET DA(2)=SDCL

           SET DA(1)=SDT

           SET DA=SDDA

           SET DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,"

 +3        DO ^DIE

           KILL DQ,DE

DIEQ       QUIT