- 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 Feb 19, 2025@00:14:53 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 ;
