SDAMBAE4 ;ALB/BOK/MJK - ADD/EDIT CON'T ; 3 FEB 1988@1210
;;5.3;Scheduling;**111,132**;Aug 13, 1993
;
COUNT ; how many procs in a visit
N SDSCI,SDAMB,Y
S X=0 F SDSCI=0:0 S SDSCI=$O(^SDV(D0,"CS",SDSCI)) Q:'SDSCI I $D(^(SDSCI,"PR")) S Y=^("PR") F SDAMB=1:1:5 S:$P(Y,U,SDAMB) X=X+1
Q
;
TOTAL ; -- reimbursement for a visit
; RAM REIMB not used, file deleted w/ CPT 6.0/ SD*5.3*111
S X=""
Q
;
LOCAL ; -- local cost for visit ; same as TOTAL but uses 'local cost' where
; available
; RAM REIMB not used, file deleted w/ CPT 6.0/ SD*5.3*111
S X=""
Q
;
STATUS ; -- amb proc status
; X = proc ; X1 = date
N % S %=""
S %=$$CPT^ICPTCOD(+X,+X1)
I %<0 S X="" Q ; if error returned
S %=$P(%,U,7) ; pull status from string
S X=$S('%:"INACTIVE",1:"ACTIVE")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMBAE4 802 printed Oct 16, 2024@18:48:01 Page 2
SDAMBAE4 ;ALB/BOK/MJK - ADD/EDIT CON'T ; 3 FEB 1988@1210
+1 ;;5.3;Scheduling;**111,132**;Aug 13, 1993
+2 ;
COUNT ; how many procs in a visit
+1 NEW SDSCI,SDAMB,Y
+2 SET X=0
FOR SDSCI=0:0
SET SDSCI=$ORDER(^SDV(D0,"CS",SDSCI))
if 'SDSCI
QUIT
IF $DATA(^(SDSCI,"PR"))
SET Y=^("PR")
FOR SDAMB=1:1:5
if $PIECE(Y,U,SDAMB)
SET X=X+1
+3 QUIT
+4 ;
TOTAL ; -- reimbursement for a visit
+1 ; RAM REIMB not used, file deleted w/ CPT 6.0/ SD*5.3*111
+2 SET X=""
+3 QUIT
+4 ;
LOCAL ; -- local cost for visit ; same as TOTAL but uses 'local cost' where
+1 ; available
+2 ; RAM REIMB not used, file deleted w/ CPT 6.0/ SD*5.3*111
+3 SET X=""
+4 QUIT
+5 ;
STATUS ; -- amb proc status
+1 ; X = proc ; X1 = date
+2 NEW %
SET %=""
+3 SET %=$$CPT^ICPTCOD(+X,+X1)
+4 ; if error returned
IF %<0
SET X=""
QUIT
+5 ; pull status from string
SET %=$PIECE(%,U,7)
+6 SET X=$SELECT('%:"INACTIVE",1:"ACTIVE")
+7 QUIT
