SDAPICO ;ALB/MJK - API - Common Check-Out Processing;04 MAR 1993 10:00 am
;;5.3;Scheduling;**27,44,78,93,132**;Aug 13, 1993
;
FILE(SDOE,SDUZ) ; File Data after checks
; Input -- SDOE Outpatient Encounter IEN
; SDUZ User ien to file 200
; Output -- <none>
;
N SDOE0,SDORG
IF '$G(SDOE) D ERRFILE^SDAPIER(110) G FILEQ
S SDOE0=$G(^SCE(+SDOE,0)),SDORG=$P(SDOE0,U,8)
;
; -- warning if check-out not required (for old appts)
IF $$REQ^SDM1A(+SDOE0)'="CO" D ERRFILE^SDAPIER(1030)
;
; -- warning if not appt and not a clinic
IF SDORG=1,'$$CLINIC^SDAMU($P(SDOE0,"^",4)) D ERRFILE^SDAPIER(130,$P(SDOE0,U,4)) G FILEQ
;
; -- warning if patient was inpatient at time of appt
IF $$INP^SDAM2(+$P(SDOE0,"^",2),+SDOE0)="I" D ERRFILE^SDAPIER(1031,+SDOE0)
;
; -- process data
D CLASS^SDAPICO1(SDOE) I $$ERRCHK^SDAPIER() G FILEQ
;
FILEQ Q
;
;
DEL(SDOE,SDFL,SDVAL) ; -- delete entry in file if match
N DA,DIK,SDI
S SDI=0
F S SDI=$O(^SDD(SDFL,"AO",+SDOE,+SDVAL,SDI)) Q:'SDI S DIK="^SDD("_SDFL_",",DA=SDI D ^DIK K DIK,DA
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAPICO 1085 printed Dec 13, 2024@02:48:27 Page 2
SDAPICO ;ALB/MJK - API - Common Check-Out Processing;04 MAR 1993 10:00 am
+1 ;;5.3;Scheduling;**27,44,78,93,132**;Aug 13, 1993
+2 ;
FILE(SDOE,SDUZ) ; File Data after checks
+1 ; Input -- SDOE Outpatient Encounter IEN
+2 ; SDUZ User ien to file 200
+3 ; Output -- <none>
+4 ;
+5 NEW SDOE0,SDORG
+6 IF '$GET(SDOE)
DO ERRFILE^SDAPIER(110)
GOTO FILEQ
+7 SET SDOE0=$GET(^SCE(+SDOE,0))
SET SDORG=$PIECE(SDOE0,U,8)
+8 ;
+9 ; -- warning if check-out not required (for old appts)
+10 IF $$REQ^SDM1A(+SDOE0)'="CO"
DO ERRFILE^SDAPIER(1030)
+11 ;
+12 ; -- warning if not appt and not a clinic
+13 IF SDORG=1
IF '$$CLINIC^SDAMU($PIECE(SDOE0,"^",4))
DO ERRFILE^SDAPIER(130,$PIECE(SDOE0,U,4))
GOTO FILEQ
+14 ;
+15 ; -- warning if patient was inpatient at time of appt
+16 IF $$INP^SDAM2(+$PIECE(SDOE0,"^",2),+SDOE0)="I"
DO ERRFILE^SDAPIER(1031,+SDOE0)
+17 ;
+18 ; -- process data
+19 DO CLASS^SDAPICO1(SDOE)
IF $$ERRCHK^SDAPIER()
GOTO FILEQ
+20 ;
FILEQ QUIT
+1 ;
+2 ;
DEL(SDOE,SDFL,SDVAL) ; -- delete entry in file if match
+1 NEW DA,DIK,SDI
+2 SET SDI=0
+3 FOR
SET SDI=$ORDER(^SDD(SDFL,"AO",+SDOE,+SDVAL,SDI))
if 'SDI
QUIT
SET DIK="^SDD("_SDFL_","
SET DA=SDI
DO ^DIK
KILL DIK,DA
+4 QUIT
+5 ;
