- SDCOM ;ALB/RMO - Process Completion - Check Out ;12 MAR 1993 11:10 am ; 1/19/07 1:37pm
- ;;5.3;Scheduling;**15,60,105,132,466,495**;Aug 13, 1993;Build 50
- ;
- EN(SDOE,SDMOD,SDCPHDL,SDCOMF) ;Complete Check Out Process
- ; Input -- SDOE Outpatient Encounter file IEN
- ; SDMOD 1=Interactive and 0=Non-interactive
- ; SDCPHDL Check Out Completion Handle [Optional]
- ; Output -- SDCOMF 0=Incomplete, 1=Complete, 2=Already Complete
- N SDEVTF
- I $P($G(^SCE(+SDOE,0)),"^",7) S SDCOMF=2 G Q
- I '$$CHK(SDOE) S SDCOMF=0 W:$G(SDMOD) !!,*7,">>> ",$$ORG^SDCOU($P($G(^SCE(+SDOE,0)),"^",8))," not checked out. Required information missing." G Q
- I '$G(SDCPHDL) N SDATA,SDCPHDL S SDEVTF=1 D EVT^SDCOU1(SDOE,"BEFORE",.SDCPHDL,.SDATA)
- D UPD(SDOE) S SDCOMF=1 I $G(SDMOD) D MSG
- I $G(SDEVTF),$G(SDCPHDL) D EVT^SDCOU1(SDOE,"AFTER",SDCPHDL,.SDATA)
- Q Q
- ;
- CHK(SDOE) ;Check if Process is Complete for Check Out
- ; Input -- SDOE Outpatient Encounter file IEN
- ; Output -- Process is Complete for Check Out
- ; 1=Yes and 0=No
- N DFN,SDCHK,SDCL,SDCLOEY,SDCOQUIT,SDCTI,SDDA,SDOE0,SDOEP,SDORG,SDSCDI,SDT,SCPROCA
- S SDOE0=$G(^SCE(+SDOE,0)),SDT=+SDOE0,DFN=+$P(SDOE0,"^",2),SDSCDI=$P(SDOE0,"^",3),SDCL=+$P(SDOE0,"^",4),SDOEP=+$P(SDOE0,"^",6),SDORG=+$P(SDOE0,"^",8),SDDA=+$P(SDOE0,"^",9)
- S SDCHK=1
- I SDOEP S SDCHK=0 G CHKQ
- I SDORG=1,'$$CODT^SDCOU(DFN,SDT,SDCL) D G CHKQ:'SDCHK
- .I $$REQ^SDM1A(SDT)="CO" S SDCHK=0 Q
- .D DT^SDCO1(DFN,SDT,SDCL,SDDA,0,"",.SDCOQUIT)
- I $$REQ^SDM1A(SDT)'="CO" G CHKQ
- I SDORG=1,'$$CLINIC^SDAMU(SDCL) G CHKQ
- ;I "^1^2^"[("^"_SDORG_"^"),$$INP^SDAM2(DFN,SDT)="I" G CHKQ ;SD*5.3*466 allow checks for inpatients as outpatients
- D CLASK^SDCO2(SDOE,.SDCLOEY)
- I $D(SDCLOEY) D G CHKQ:'SDCHK
- .S SDCTI=0 F S SDCTI=$O(SDCLOEY(SDCTI)) Q:'SDCTI I $G(SDCLOEY(SDCTI))="" S SDCHK=0
- ;sent encounter to ASCD for review
- I $D(SDCLOEY(3)) D
- .N SCDXS,SCAMDX,DXS D GETDX^SDOE(SDOE,"SCDXS")
- .S DXS=0 F S DXS=$O(SCDXS(DXS)) Q:'DXS S SCAMDX(+SCDXS(DXS))=""
- .I $O(SCAMDX(0)) D ST^SDSCAPI(SDOE,.SCAMDX)
- I $$PRASK^SDCO3(SDOE),'$$PRV^SDOE(SDOE) S SDCHK=0 G CHKQ
- I $$DXASK^SDCO4(SDOE),'$$GETPDX^SDOE(SDOE) S SDCHK=0 G CHKQ
- I '$$CPT^SDOE(SDOE) S SDCHK=0 G CHKQ
- CHKQ Q +$G(SDCHK)
- ;
- UPD(SDOE) ;Update Check Out Process Completion Date
- ; Input -- SDOE Outpatient Encounter file IEN
- ; Output -- Update Check Out Process Completion Date
- N DA,DE,DIE,DQ,DR
- G UPDQ:'$D(^SCE(+SDOE,0))
- S DA=+SDOE,DIE="^SCE(",DR=".07///NOW"
- D ^DIE
- UPDQ Q
- ;
- MSG ;Check Out Message
- W !!?8,"...checked out ",$$FTIME^VALM1($P($G(^SCE(+SDOE,0)),"^",7))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCOM 2617 printed Dec 13, 2024@02:49:33 Page 2
- SDCOM ;ALB/RMO - Process Completion - Check Out ;12 MAR 1993 11:10 am ; 1/19/07 1:37pm
- +1 ;;5.3;Scheduling;**15,60,105,132,466,495**;Aug 13, 1993;Build 50
- +2 ;
- EN(SDOE,SDMOD,SDCPHDL,SDCOMF) ;Complete Check Out Process
- +1 ; Input -- SDOE Outpatient Encounter file IEN
- +2 ; SDMOD 1=Interactive and 0=Non-interactive
- +3 ; SDCPHDL Check Out Completion Handle [Optional]
- +4 ; Output -- SDCOMF 0=Incomplete, 1=Complete, 2=Already Complete
- +5 NEW SDEVTF
- +6 IF $PIECE($GET(^SCE(+SDOE,0)),"^",7)
- SET SDCOMF=2
- GOTO Q
- +7 IF '$$CHK(SDOE)
- SET SDCOMF=0
- if $GET(SDMOD)
- WRITE !!,*7,">>> ",$$ORG^SDCOU($PIECE($GET(^SCE(+SDOE,0)),"^",8))," not checked out. Required information missing."
- GOTO Q
- +8 IF '$GET(SDCPHDL)
- NEW SDATA,SDCPHDL
- SET SDEVTF=1
- DO EVT^SDCOU1(SDOE,"BEFORE",.SDCPHDL,.SDATA)
- +9 DO UPD(SDOE)
- SET SDCOMF=1
- IF $GET(SDMOD)
- DO MSG
- +10 IF $GET(SDEVTF)
- IF $GET(SDCPHDL)
- DO EVT^SDCOU1(SDOE,"AFTER",SDCPHDL,.SDATA)
- Q QUIT
- +1 ;
- CHK(SDOE) ;Check if Process is Complete for Check Out
- +1 ; Input -- SDOE Outpatient Encounter file IEN
- +2 ; Output -- Process is Complete for Check Out
- +3 ; 1=Yes and 0=No
- +4 NEW DFN,SDCHK,SDCL,SDCLOEY,SDCOQUIT,SDCTI,SDDA,SDOE0,SDOEP,SDORG,SDSCDI,SDT,SCPROCA
- +5 SET SDOE0=$GET(^SCE(+SDOE,0))
- SET SDT=+SDOE0
- SET DFN=+$PIECE(SDOE0,"^",2)
- SET SDSCDI=$PIECE(SDOE0,"^",3)
- SET SDCL=+$PIECE(SDOE0,"^",4)
- SET SDOEP=+$PIECE(SDOE0,"^",6)
- SET SDORG=+$PIECE(SDOE0,"^",8)
- SET SDDA=+$PIECE(SDOE0,"^",9)
- +6 SET SDCHK=1
- +7 IF SDOEP
- SET SDCHK=0
- GOTO CHKQ
- +8 IF SDORG=1
- IF '$$CODT^SDCOU(DFN,SDT,SDCL)
- Begin DoDot:1
- +9 IF $$REQ^SDM1A(SDT)="CO"
- SET SDCHK=0
- QUIT
- +10 DO DT^SDCO1(DFN,SDT,SDCL,SDDA,0,"",.SDCOQUIT)
- End DoDot:1
- if 'SDCHK
- GOTO CHKQ
- +11 IF $$REQ^SDM1A(SDT)'="CO"
- GOTO CHKQ
- +12 IF SDORG=1
- IF '$$CLINIC^SDAMU(SDCL)
- GOTO CHKQ
- +13 ;I "^1^2^"[("^"_SDORG_"^"),$$INP^SDAM2(DFN,SDT)="I" G CHKQ ;SD*5.3*466 allow checks for inpatients as outpatients
- +14 DO CLASK^SDCO2(SDOE,.SDCLOEY)
- +15 IF $DATA(SDCLOEY)
- Begin DoDot:1
- +16 SET SDCTI=0
- FOR
- SET SDCTI=$ORDER(SDCLOEY(SDCTI))
- if 'SDCTI
- QUIT
- IF $GET(SDCLOEY(SDCTI))=""
- SET SDCHK=0
- End DoDot:1
- if 'SDCHK
- GOTO CHKQ
- +17 ;sent encounter to ASCD for review
- +18 IF $DATA(SDCLOEY(3))
- Begin DoDot:1
- +19 NEW SCDXS,SCAMDX,DXS
- DO GETDX^SDOE(SDOE,"SCDXS")
- +20 SET DXS=0
- FOR
- SET DXS=$ORDER(SCDXS(DXS))
- if 'DXS
- QUIT
- SET SCAMDX(+SCDXS(DXS))=""
- +21 IF $ORDER(SCAMDX(0))
- DO ST^SDSCAPI(SDOE,.SCAMDX)
- End DoDot:1
- +22 IF $$PRASK^SDCO3(SDOE)
- IF '$$PRV^SDOE(SDOE)
- SET SDCHK=0
- GOTO CHKQ
- +23 IF $$DXASK^SDCO4(SDOE)
- IF '$$GETPDX^SDOE(SDOE)
- SET SDCHK=0
- GOTO CHKQ
- +24 IF '$$CPT^SDOE(SDOE)
- SET SDCHK=0
- GOTO CHKQ
- CHKQ QUIT +$GET(SDCHK)
- +1 ;
- UPD(SDOE) ;Update Check Out Process Completion Date
- +1 ; Input -- SDOE Outpatient Encounter file IEN
- +2 ; Output -- Update Check Out Process Completion Date
- +3 NEW DA,DE,DIE,DQ,DR
- +4 if '$DATA(^SCE(+SDOE,0))
- GOTO UPDQ
- +5 SET DA=+SDOE
- SET DIE="^SCE("
- SET DR=".07///NOW"
- +6 DO ^DIE
- UPDQ QUIT
- +1 ;
- MSG ;Check Out Message
- +1 WRITE !!?8,"...checked out ",$$FTIME^VALM1($PIECE($GET(^SCE(+SDOE,0)),"^",7))
- +2 QUIT