Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDCOAM

SDCOAM.m

Go to the documentation of this file.
  1. SDCOAM ;ALB/RMO - Appt Mgmt Actions - Check Out; 11 FEB 1993 10:00 am
  1. ;;5.3;Scheduling;**1,20,27,66,132**;08/13/93
  1. ;
  1. CO(SDCOACT,SDCOACTD) ;Check Out Classification, Provider and Diagnosis
  1. ; Actions on Appt Mgmt
  1. N DFN,SDCL,SDCOAP,SDDA,SDOE,SDT,VALMY
  1. S VALMBCK=""
  1. D EN^VALM2(XQORNOD(0))
  1. D FULL^VALM1
  1. S SDCOAP=0
  1. F S SDCOAP=$O(VALMY(SDCOAP)) Q:'SDCOAP D
  1. .I $D(^TMP("SDAMIDX",$J,SDCOAP)) K SDAT S SDAT=^(SDCOAP) D
  1. ..W !!,^TMP("SDAM",$J,+SDAT,0)
  1. ..S DFN=+$P(SDAT,"^",2),SDT=+$P(SDAT,"^",3),SDCL=+$P(SDAT,"^",4),SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)
  1. ..S SDOE=+$P($G(^DPT(DFN,"S",SDT,0)),"^",20)
  1. ..I 'SDOE!('$$CODT^SDCOU(DFN,SDT,SDCL)) W !!,*7,">>> The appointment must have a check out date/time to update ",SDCOACTD,"." D PAUSE^VALM1 Q
  1. ..D ACT(SDCOACT,SDOE,DFN,SDT,SDCL,SDDA,+SDAT)
  1. S VALMBCK="R"
  1. K SDAT
  1. COQ Q
  1. ;
  1. ACT(SDCOACT,SDOE,DFN,SDT,SDCL,SDDA,SDLNE) ; -- Check Out Actions
  1. N SDCOMF,SDCOQUIT,SDHL,SDVISIT,SDATA,SDHDL
  1. ;
  1. S SDVISIT=+$P($G(^SCE(+SDOE,0)),U,5)
  1. ;
  1. ; -- quit if not ok to edit
  1. IF '$$EDITOK^SDCO3($G(SDOE),1) G ACTQ
  1. ;
  1. ; -- set pce action parameter
  1. S SDPXACT=""
  1. I $G(SDCOACT)="CL" S SDPXACT="SCC"
  1. I $G(SDCOACT)="PR" S SDPXACT="PRV"
  1. I $G(SDCOACT)="DX" S SDPXACT="POV"
  1. I $G(SDCOACT)="CPT" S SDPXACT="CPT"
  1. ;
  1. ; -- quit if no action set
  1. IF SDPXACT="" G ACTQ
  1. ;
  1. ; -- do pce interview then rebuild appt list
  1. S X=$$INTV^PXAPI(SDPXACT,"SD","PIMS",.SDVISIT,.SDHL,DFN)
  1. D BLD^SDAM
  1. ACTQ Q
  1. ;
  1. PD ;Entry point for SDAM PATIENT DEMOGRAPHICS protocol
  1. N SDCOAP,VALMY
  1. S VALMBCK=""
  1. D FULL^VALM1
  1. I SDAMTYP="P" W !!,VALMHDR(1),! D DEM(SDFN)
  1. I SDAMTYP="C" D
  1. .D EN^VALM2(XQORNOD(0))
  1. .S SDCOAP=0 F S SDCOAP=$O(VALMY(SDCOAP)) Q:'SDCOAP D
  1. ..I $D(^TMP("SDAMIDX",$J,SDCOAP)) K SDAT S SDAT=^(SDCOAP) D
  1. ...W !!,^TMP("SDAM",$J,+SDAT,0),!
  1. ...D DEM(+$P(SDAT,"^",2))
  1. S VALMBCK="R"
  1. PDQ Q
  1. ;
  1. DEM(DFN) ;Demographics
  1. D QUES^DGRPU1(DFN,"ADD")
  1. Q
  1. ;
  1. DC ;Entry point for SDAM DISCHARGE CLINIC protocol
  1. N SDCOAP,VALMY
  1. S VALMBCK=""
  1. D FULL^VALM1
  1. I SDAMTYP="P" W !!,VALMHDR(1),! D DIS(SDFN)
  1. I SDAMTYP="C" D
  1. .D EN^VALM2(XQORNOD(0))
  1. .S SDCOAP=0 F S SDCOAP=$O(VALMY(SDCOAP)) Q:'SDCOAP D
  1. ..I $D(^TMP("SDAMIDX",$J,SDCOAP)) K SDAT S SDAT=^(SDCOAP) D
  1. ...W !!,^TMP("SDAM",$J,+SDAT,0),!
  1. ...D DIS(+$P(SDAT,"^",2),$P(SDAT,"^",4))
  1. S VALMBCK="R"
  1. DCQ Q
  1. ;
  1. DIS(SDFN,SDCLN) ;Discharge from Clinic
  1. N SDAMERR
  1. D ^SDCD
  1. I $D(SDAMERR) D PAUSE^VALM1
  1. Q
  1. ;
  1. DEL ;Entry point for SDAM DELETE CHECK OUT protocol
  1. I '$D(^XUSEC("SD SUPERVISOR",DUZ)) W !!,*7,">>> You must have the 'SD SUPERVISOR' key to delete an appointment check out." D PAUSE^VALM1 S VALMBCK="R" G DELQ
  1. N DFN,SDCL,SDCOAP,SDDA,SDOE,SDT,VALMY,VALSTP
  1. S VALMBCK="",VALSTP="" ;VALSTP is used in scdxhldr to identify deletes
  1. D EN^VALM2(XQORNOD(0))
  1. D FULL^VALM1
  1. S SDCOAP=0
  1. F S SDCOAP=$O(VALMY(SDCOAP)) Q:'SDCOAP D
  1. .I $D(^TMP("SDAMIDX",$J,SDCOAP)) K SDAT S SDAT=^(SDCOAP) D
  1. ..W !!,^TMP("SDAM",$J,+SDAT,0)
  1. ..S DFN=+$P(SDAT,"^",2),SDT=+$P(SDAT,"^",3),SDCL=+$P(SDAT,"^",4),SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)
  1. ..S SDOE=+$P($G(^DPT(DFN,"S",SDT,0)),"^",20)
  1. ..I 'SDOE!('$$CODT^SDCOU(DFN,SDT,SDCL)) W !!,*7,">>> The appointment must have a check out date/time to delete." D PAUSE^VALM1 Q
  1. ..I '$$ASK Q
  1. ..N SDATA,SDELHDL
  1. ..IF '$$EDITOK^SDCO3(SDOE,1) Q
  1. ..S SDELHDL=$$HANDLE^SDAMEVT(1)
  1. ..D EN^SDCODEL(SDOE,1,SDELHDL),PAUSE^VALM1
  1. ..D BLD^SDAM
  1. ..S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
  1. S VALMBCK="R"
  1. K SDAT
  1. DELQ Q
  1. ;
  1. ASK() ;Ask if user is sure they want to delete the check out
  1. N DIR,DTOUT,DUOUT,Y
  1. W !!,*7,">>> Deleting the appointment check out will also delete any check out related",!?4,"information. This information may include classifications, procedures,",!?4,"providers and diagnoses."
  1. S DIR("A")="Are you sure you want to delete the appointment check out"
  1. S DIR("B")="NO",DIR(0)="Y" W ! D ^DIR
  1. Q +$G(Y)