SDAMBAE4.m

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 ---SDAMBAE4   802     printed  Apr 09, 2024@21:53:42                                                                                                                                                                                                     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