- SDCOAM ;ALB/RMO - Appt Mgmt Actions - Check Out; 11 FEB 1993 10:00 am
- ;;5.3;Scheduling;**1,20,27,66,132**;08/13/93
- ;
- CO(SDCOACT,SDCOACTD) ;Check Out Classification, Provider and Diagnosis
- ; Actions on Appt Mgmt
- N DFN,SDCL,SDCOAP,SDDA,SDOE,SDT,VALMY
- S VALMBCK=""
- D EN^VALM2(XQORNOD(0))
- D FULL^VALM1
- S SDCOAP=0
- F S SDCOAP=$O(VALMY(SDCOAP)) Q:'SDCOAP D
- .I $D(^TMP("SDAMIDX",$J,SDCOAP)) K SDAT S SDAT=^(SDCOAP) D
- ..W !!,^TMP("SDAM",$J,+SDAT,0)
- ..S DFN=+$P(SDAT,"^",2),SDT=+$P(SDAT,"^",3),SDCL=+$P(SDAT,"^",4),SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)
- ..S SDOE=+$P($G(^DPT(DFN,"S",SDT,0)),"^",20)
- ..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
- ..D ACT(SDCOACT,SDOE,DFN,SDT,SDCL,SDDA,+SDAT)
- S VALMBCK="R"
- K SDAT
- COQ Q
- ;
- ACT(SDCOACT,SDOE,DFN,SDT,SDCL,SDDA,SDLNE) ; -- Check Out Actions
- N SDCOMF,SDCOQUIT,SDHL,SDVISIT,SDATA,SDHDL
- ;
- S SDVISIT=+$P($G(^SCE(+SDOE,0)),U,5)
- ;
- ; -- quit if not ok to edit
- IF '$$EDITOK^SDCO3($G(SDOE),1) G ACTQ
- ;
- ; -- set pce action parameter
- S SDPXACT=""
- I $G(SDCOACT)="CL" S SDPXACT="SCC"
- I $G(SDCOACT)="PR" S SDPXACT="PRV"
- I $G(SDCOACT)="DX" S SDPXACT="POV"
- I $G(SDCOACT)="CPT" S SDPXACT="CPT"
- ;
- ; -- quit if no action set
- IF SDPXACT="" G ACTQ
- ;
- ; -- do pce interview then rebuild appt list
- S X=$$INTV^PXAPI(SDPXACT,"SD","PIMS",.SDVISIT,.SDHL,DFN)
- D BLD^SDAM
- ACTQ Q
- ;
- PD ;Entry point for SDAM PATIENT DEMOGRAPHICS protocol
- N SDCOAP,VALMY
- S VALMBCK=""
- D FULL^VALM1
- I SDAMTYP="P" W !!,VALMHDR(1),! D DEM(SDFN)
- I SDAMTYP="C" D
- .D EN^VALM2(XQORNOD(0))
- .S SDCOAP=0 F S SDCOAP=$O(VALMY(SDCOAP)) Q:'SDCOAP D
- ..I $D(^TMP("SDAMIDX",$J,SDCOAP)) K SDAT S SDAT=^(SDCOAP) D
- ...W !!,^TMP("SDAM",$J,+SDAT,0),!
- ...D DEM(+$P(SDAT,"^",2))
- S VALMBCK="R"
- PDQ Q
- ;
- DEM(DFN) ;Demographics
- D QUES^DGRPU1(DFN,"ADD")
- Q
- ;
- DC ;Entry point for SDAM DISCHARGE CLINIC protocol
- N SDCOAP,VALMY
- S VALMBCK=""
- D FULL^VALM1
- I SDAMTYP="P" W !!,VALMHDR(1),! D DIS(SDFN)
- I SDAMTYP="C" D
- .D EN^VALM2(XQORNOD(0))
- .S SDCOAP=0 F S SDCOAP=$O(VALMY(SDCOAP)) Q:'SDCOAP D
- ..I $D(^TMP("SDAMIDX",$J,SDCOAP)) K SDAT S SDAT=^(SDCOAP) D
- ...W !!,^TMP("SDAM",$J,+SDAT,0),!
- ...D DIS(+$P(SDAT,"^",2),$P(SDAT,"^",4))
- S VALMBCK="R"
- DCQ Q
- ;
- DIS(SDFN,SDCLN) ;Discharge from Clinic
- N SDAMERR
- D ^SDCD
- I $D(SDAMERR) D PAUSE^VALM1
- Q
- ;
- DEL ;Entry point for SDAM DELETE CHECK OUT protocol
- 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
- N DFN,SDCL,SDCOAP,SDDA,SDOE,SDT,VALMY,VALSTP
- S VALMBCK="",VALSTP="" ;VALSTP is used in scdxhldr to identify deletes
- D EN^VALM2(XQORNOD(0))
- D FULL^VALM1
- S SDCOAP=0
- F S SDCOAP=$O(VALMY(SDCOAP)) Q:'SDCOAP D
- .I $D(^TMP("SDAMIDX",$J,SDCOAP)) K SDAT S SDAT=^(SDCOAP) D
- ..W !!,^TMP("SDAM",$J,+SDAT,0)
- ..S DFN=+$P(SDAT,"^",2),SDT=+$P(SDAT,"^",3),SDCL=+$P(SDAT,"^",4),SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)
- ..S SDOE=+$P($G(^DPT(DFN,"S",SDT,0)),"^",20)
- ..I 'SDOE!('$$CODT^SDCOU(DFN,SDT,SDCL)) W !!,*7,">>> The appointment must have a check out date/time to delete." D PAUSE^VALM1 Q
- ..I '$$ASK Q
- ..N SDATA,SDELHDL
- ..IF '$$EDITOK^SDCO3(SDOE,1) Q
- ..S SDELHDL=$$HANDLE^SDAMEVT(1)
- ..D EN^SDCODEL(SDOE,1,SDELHDL),PAUSE^VALM1
- ..D BLD^SDAM
- ..S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
- S VALMBCK="R"
- K SDAT
- DELQ Q
- ;
- ASK() ;Ask if user is sure they want to delete the check out
- N DIR,DTOUT,DUOUT,Y
- 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."
- S DIR("A")="Are you sure you want to delete the appointment check out"
- S DIR("B")="NO",DIR(0)="Y" W ! D ^DIR
- Q +$G(Y)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCOAM 3900 printed Feb 19, 2025@00:15:57 Page 2
- 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
- +2 ;
- CO(SDCOACT,SDCOACTD) ;Check Out Classification, Provider and Diagnosis
- +1 ; Actions on Appt Mgmt
- +2 NEW DFN,SDCL,SDCOAP,SDDA,SDOE,SDT,VALMY
- +3 SET VALMBCK=""
- +4 DO EN^VALM2(XQORNOD(0))
- +5 DO FULL^VALM1
- +6 SET SDCOAP=0
- +7 FOR
- SET SDCOAP=$ORDER(VALMY(SDCOAP))
- if 'SDCOAP
- QUIT
- Begin DoDot:1
- +8 IF $DATA(^TMP("SDAMIDX",$JOB,SDCOAP))
- KILL SDAT
- SET SDAT=^(SDCOAP)
- Begin DoDot:2
- +9 WRITE !!,^TMP("SDAM",$JOB,+SDAT,0)
- +10 SET DFN=+$PIECE(SDAT,"^",2)
- SET SDT=+$PIECE(SDAT,"^",3)
- SET SDCL=+$PIECE(SDAT,"^",4)
- SET SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)
- +11 SET SDOE=+$PIECE($GET(^DPT(DFN,"S",SDT,0)),"^",20)
- +12 IF 'SDOE!('$$CODT^SDCOU(DFN,SDT,SDCL))
- WRITE !!,*7,">>> The appointment must have a check out date/time to update ",SDCOACTD,"."
- DO PAUSE^VALM1
- QUIT
- +13 DO ACT(SDCOACT,SDOE,DFN,SDT,SDCL,SDDA,+SDAT)
- End DoDot:2
- End DoDot:1
- +14 SET VALMBCK="R"
- +15 KILL SDAT
- COQ QUIT
- +1 ;
- ACT(SDCOACT,SDOE,DFN,SDT,SDCL,SDDA,SDLNE) ; -- Check Out Actions
- +1 NEW SDCOMF,SDCOQUIT,SDHL,SDVISIT,SDATA,SDHDL
- +2 ;
- +3 SET SDVISIT=+$PIECE($GET(^SCE(+SDOE,0)),U,5)
- +4 ;
- +5 ; -- quit if not ok to edit
- +6 IF '$$EDITOK^SDCO3($GET(SDOE),1)
- GOTO ACTQ
- +7 ;
- +8 ; -- set pce action parameter
- +9 SET SDPXACT=""
- +10 IF $GET(SDCOACT)="CL"
- SET SDPXACT="SCC"
- +11 IF $GET(SDCOACT)="PR"
- SET SDPXACT="PRV"
- +12 IF $GET(SDCOACT)="DX"
- SET SDPXACT="POV"
- +13 IF $GET(SDCOACT)="CPT"
- SET SDPXACT="CPT"
- +14 ;
- +15 ; -- quit if no action set
- +16 IF SDPXACT=""
- GOTO ACTQ
- +17 ;
- +18 ; -- do pce interview then rebuild appt list
- +19 SET X=$$INTV^PXAPI(SDPXACT,"SD","PIMS",.SDVISIT,.SDHL,DFN)
- +20 DO BLD^SDAM
- ACTQ QUIT
- +1 ;
- PD ;Entry point for SDAM PATIENT DEMOGRAPHICS protocol
- +1 NEW SDCOAP,VALMY
- +2 SET VALMBCK=""
- +3 DO FULL^VALM1
- +4 IF SDAMTYP="P"
- WRITE !!,VALMHDR(1),!
- DO DEM(SDFN)
- +5 IF SDAMTYP="C"
- Begin DoDot:1
- +6 DO EN^VALM2(XQORNOD(0))
- +7 SET SDCOAP=0
- FOR
- SET SDCOAP=$ORDER(VALMY(SDCOAP))
- if 'SDCOAP
- QUIT
- Begin DoDot:2
- +8 IF $DATA(^TMP("SDAMIDX",$JOB,SDCOAP))
- KILL SDAT
- SET SDAT=^(SDCOAP)
- Begin DoDot:3
- +9 WRITE !!,^TMP("SDAM",$JOB,+SDAT,0),!
- +10 DO DEM(+$PIECE(SDAT,"^",2))
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 SET VALMBCK="R"
- PDQ QUIT
- +1 ;
- DEM(DFN) ;Demographics
- +1 DO QUES^DGRPU1(DFN,"ADD")
- +2 QUIT
- +3 ;
- DC ;Entry point for SDAM DISCHARGE CLINIC protocol
- +1 NEW SDCOAP,VALMY
- +2 SET VALMBCK=""
- +3 DO FULL^VALM1
- +4 IF SDAMTYP="P"
- WRITE !!,VALMHDR(1),!
- DO DIS(SDFN)
- +5 IF SDAMTYP="C"
- Begin DoDot:1
- +6 DO EN^VALM2(XQORNOD(0))
- +7 SET SDCOAP=0
- FOR
- SET SDCOAP=$ORDER(VALMY(SDCOAP))
- if 'SDCOAP
- QUIT
- Begin DoDot:2
- +8 IF $DATA(^TMP("SDAMIDX",$JOB,SDCOAP))
- KILL SDAT
- SET SDAT=^(SDCOAP)
- Begin DoDot:3
- +9 WRITE !!,^TMP("SDAM",$JOB,+SDAT,0),!
- +10 DO DIS(+$PIECE(SDAT,"^",2),$PIECE(SDAT,"^",4))
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 SET VALMBCK="R"
- DCQ QUIT
- +1 ;
- DIS(SDFN,SDCLN) ;Discharge from Clinic
- +1 NEW SDAMERR
- +2 DO ^SDCD
- +3 IF $DATA(SDAMERR)
- DO PAUSE^VALM1
- +4 QUIT
- +5 ;
- DEL ;Entry point for SDAM DELETE CHECK OUT protocol
- +1 IF '$DATA(^XUSEC("SD SUPERVISOR",DUZ))
- WRITE !!,*7,">>> You must have the 'SD SUPERVISOR' key to delete an appointment check out."
- DO PAUSE^VALM1
- SET VALMBCK="R"
- GOTO DELQ
- +2 NEW DFN,SDCL,SDCOAP,SDDA,SDOE,SDT,VALMY,VALSTP
- +3 ;VALSTP is used in scdxhldr to identify deletes
- SET VALMBCK=""
- SET VALSTP=""
- +4 DO EN^VALM2(XQORNOD(0))
- +5 DO FULL^VALM1
- +6 SET SDCOAP=0
- +7 FOR
- SET SDCOAP=$ORDER(VALMY(SDCOAP))
- if 'SDCOAP
- QUIT
- Begin DoDot:1
- +8 IF $DATA(^TMP("SDAMIDX",$JOB,SDCOAP))
- KILL SDAT
- SET SDAT=^(SDCOAP)
- Begin DoDot:2
- +9 WRITE !!,^TMP("SDAM",$JOB,+SDAT,0)
- +10 SET DFN=+$PIECE(SDAT,"^",2)
- SET SDT=+$PIECE(SDAT,"^",3)
- SET SDCL=+$PIECE(SDAT,"^",4)
- SET SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)
- +11 SET SDOE=+$PIECE($GET(^DPT(DFN,"S",SDT,0)),"^",20)
- +12 IF 'SDOE!('$$CODT^SDCOU(DFN,SDT,SDCL))
- WRITE !!,*7,">>> The appointment must have a check out date/time to delete."
- DO PAUSE^VALM1
- QUIT
- +13 IF '$$ASK
- QUIT
- +14 NEW SDATA,SDELHDL
- +15 IF '$$EDITOK^SDCO3(SDOE,1)
- QUIT
- +16 SET SDELHDL=$$HANDLE^SDAMEVT(1)
- +17 DO EN^SDCODEL(SDOE,1,SDELHDL)
- DO PAUSE^VALM1
- +18 DO BLD^SDAM
- +19 SET SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
- End DoDot:2
- End DoDot:1
- +20 SET VALMBCK="R"
- +21 KILL SDAT
- DELQ QUIT
- +1 ;
- ASK() ;Ask if user is sure they want to delete the check out
- +1 NEW DIR,DTOUT,DUOUT,Y
- +2 WRITE !!,*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."
- +3 SET DIR("A")="Are you sure you want to delete the appointment check out"
- +4 SET DIR("B")="NO"
- SET DIR(0)="Y"
- WRITE !
- DO ^DIR
- +5 QUIT +$GET(Y)