- 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
