SDOECPT ;ALB/MJK - ACRP CPT APIs For An Encounter ;8/12/96
;;5.3;Scheduling;**131,196**;Aug 13, 1993
;06/22/99 ACS - Added CPT modifier API calls
;06/22/99 ACS - Added CPT modifier logic for the AMB CARE toolkit
;
CPT(SDOE,SDERR) ; -- SDOE ASSIGNED A PROCEDURE
; API ID: 65
;
;
N SDOK
S SDOK=0
;
; -- do validation checks
IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G CPTQ
IF $$OLD^SDOEUT(SDOE) S SDOK=$$OLDCPT(SDOE) G CPTQ
;
S SDOK=$$CPT^PXAPIOE($$VIEN^SDOEUT(.SDOE),$G(SDERR))
CPTQ Q SDOK
;
;
GETCPT(SDOE,SDCPT,SDERR) ; -- SDOE GET PROCEDURES
; API ID: 61
;
;
GETCPTG ; -- goto entry point
; -- do validation checks
IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G GETCPTQ
IF $$OLD^SDOEUT(SDOE) D OLDCPTS(SDOE,.SDCPT) G GETCPTQ
;
;D GETCPT^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDCPT,$G(SDERR))
N MODNODE
D CPTARR^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDCPT,$G(SDERR))
S MODNODE=0
;
; spin through array VAFPROC built from global file ^AUPNVCPT
F S MODNODE=+$O(@SDCPT@(MODNODE)) Q:'MODNODE S @SDCPT@(MODNODE)=$G(@SDCPT@(MODNODE,0))
GETCPTQ Q
;
;
FINDCPT(SDOE,SDCPTID,SDERR) ; -- SDOE FIND PROCEDURE
; API ID: 71
;
;
N SDCPTS,SDOK,I
S SDCPTS="SDCPTS"
;
; -- do validation checks
IF '$$VALCPT(.SDCPTID,$G(SDERR)) S SDOK=0 G FINDCPTQ
;
;D GETCPT(.SDOE,.SDCPTS,$G(SDERR))
D GETCPT(.SDOE,SDCPTS,$G(SDERR))
S (I,SDOK)=0
F S I=$O(SDCPTS(I)) Q:'I S SDOK=(+SDCPTS(I)=SDCPTID) Q:SDOK
FINDCPTQ Q SDOK
;
;
VALCPT(SDCPTID,SDERR) ; -- validate CPT input
;
; -- do checks
;IF SDCPTID,$D(^ICPT(SDCPTID,0)) Q 1
IF SDCPTID,$$CPT^ICPTCOD(SDCPTID,,1)>0 Q 1
;
; -- build error msg
N SDIN,SDOUT
S SDIN("ID")=SDCPTID
S SDOUT("ID")=SDCPTID
D BLD^SDQVAL(4096800.005,.SDIN,.SDOUT,$G(SDERR))
Q 0
;
;
OLDCPT(SDOE) ; -- at least one cpt for OLD encounter?
N SDXARY
D OLDCPTS(SDOE,"SDXARY")
Q (+$G(SDXARY)>0)
;
OLDCPTS(SDOE,SDARY) ; -- get cpt's for OLD encounter
N SDIEN,SDCNT,Y,X,SDYARY
D COUNT(.SDOE,"SDYARY")
S (SDIEN,SDCNT)=0
F S SDIEN=$O(SDYARY(SDIEN)) Q:'SDIEN D
. S SDCNT=SDCNT+1,X=$G(SDYARY(SDIEN))
. S $P(Y,U,1)=SDIEN ; -- cpt ien
. S $P(Y,U,16)=+X ; -- quantity
. S @SDARY@(SDIEN)=Y
S @SDARY=SDCNT
Q
;
COUNT(SDOE,SDZARY) ; -- count/find cpt's for OLD encounter
N SDFN,SDATE,SDCL,SDT,SDSC,SDSC0,SDPR,SDPROC,I,SDOE0
S SDOE0=$G(^SCE(SDOE,0))
S SDFN=+$P(SDOE0,U,2)
S SDATE=+SDOE0
S SDCL=+$P(SDOE0,U,4)
S SDT=+$G(^SDV("ADT",SDFN,$P(SDATE,".")))
;
S SDSC=0 F S SDSC=$O(^SDV(SDT,"CS",SDSC)) Q:'SDSC D
. S SDSC0=$G(^SDV(SDT,"CS",SDSC,0))
. S SDPR=$G(^SDV(SDT,"CS",SDSC,"PR"))
.;
.; -- only for clinic assoicated with encounter
.; ('old' data lumped all cpts together for day)
.;
. IF $P($G(^DIC(40.7,+SDSC0,0)),U,2)=900,$P(SDSC0,U,3)=SDCL D
..; F I=1:1:5 S SDPROC=+$P(SDPR,U,I) IF $D(^ICPT(SDPROC,0)) S @SDZARY@(SDPROC)=$G(@SDZARY@(SDPROC))+1
.. F I=1:1:5 S SDPROC=+$P(SDPR,U,I) IF $$CPT^ICPTCOD(SDPROC,,1)>0 S @SDZARY@(SDPROC)=$G(@SDZARY@(SDPROC))+1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDOECPT 3029 printed Dec 13, 2024@02:59:04 Page 2
SDOECPT ;ALB/MJK - ACRP CPT APIs For An Encounter ;8/12/96
+1 ;;5.3;Scheduling;**131,196**;Aug 13, 1993
+2 ;06/22/99 ACS - Added CPT modifier API calls
+3 ;06/22/99 ACS - Added CPT modifier logic for the AMB CARE toolkit
+4 ;
CPT(SDOE,SDERR) ; -- SDOE ASSIGNED A PROCEDURE
+1 ; API ID: 65
+2 ;
+3 ;
+4 NEW SDOK
+5 SET SDOK=0
+6 ;
+7 ; -- do validation checks
+8 IF '$$VALOE^SDOEOE(.SDOE,$GET(SDERR))
GOTO CPTQ
+9 IF $$OLD^SDOEUT(SDOE)
SET SDOK=$$OLDCPT(SDOE)
GOTO CPTQ
+10 ;
+11 SET SDOK=$$CPT^PXAPIOE($$VIEN^SDOEUT(.SDOE),$GET(SDERR))
CPTQ QUIT SDOK
+1 ;
+2 ;
GETCPT(SDOE,SDCPT,SDERR) ; -- SDOE GET PROCEDURES
+1 ; API ID: 61
+2 ;
+3 ;
GETCPTG ; -- goto entry point
+1 ; -- do validation checks
+2 IF '$$VALOE^SDOEOE(.SDOE,$GET(SDERR))
GOTO GETCPTQ
+3 IF $$OLD^SDOEUT(SDOE)
DO OLDCPTS(SDOE,.SDCPT)
GOTO GETCPTQ
+4 ;
+5 ;D GETCPT^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDCPT,$G(SDERR))
+6 NEW MODNODE
+7 DO CPTARR^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDCPT,$GET(SDERR))
+8 SET MODNODE=0
+9 ;
+10 ; spin through array VAFPROC built from global file ^AUPNVCPT
+11 FOR
SET MODNODE=+$ORDER(@SDCPT@(MODNODE))
if 'MODNODE
QUIT
SET @SDCPT@(MODNODE)=$GET(@SDCPT@(MODNODE,0))
GETCPTQ QUIT
+1 ;
+2 ;
FINDCPT(SDOE,SDCPTID,SDERR) ; -- SDOE FIND PROCEDURE
+1 ; API ID: 71
+2 ;
+3 ;
+4 NEW SDCPTS,SDOK,I
+5 SET SDCPTS="SDCPTS"
+6 ;
+7 ; -- do validation checks
+8 IF '$$VALCPT(.SDCPTID,$GET(SDERR))
SET SDOK=0
GOTO FINDCPTQ
+9 ;
+10 ;D GETCPT(.SDOE,.SDCPTS,$G(SDERR))
+11 DO GETCPT(.SDOE,SDCPTS,$GET(SDERR))
+12 SET (I,SDOK)=0
+13 FOR
SET I=$ORDER(SDCPTS(I))
if 'I
QUIT
SET SDOK=(+SDCPTS(I)=SDCPTID)
if SDOK
QUIT
FINDCPTQ QUIT SDOK
+1 ;
+2 ;
VALCPT(SDCPTID,SDERR) ; -- validate CPT input
+1 ;
+2 ; -- do checks
+3 ;IF SDCPTID,$D(^ICPT(SDCPTID,0)) Q 1
+4 IF SDCPTID
IF $$CPT^ICPTCOD(SDCPTID,,1)>0
QUIT 1
+5 ;
+6 ; -- build error msg
+7 NEW SDIN,SDOUT
+8 SET SDIN("ID")=SDCPTID
+9 SET SDOUT("ID")=SDCPTID
+10 DO BLD^SDQVAL(4096800.005,.SDIN,.SDOUT,$GET(SDERR))
+11 QUIT 0
+12 ;
+13 ;
OLDCPT(SDOE) ; -- at least one cpt for OLD encounter?
+1 NEW SDXARY
+2 DO OLDCPTS(SDOE,"SDXARY")
+3 QUIT (+$GET(SDXARY)>0)
+4 ;
OLDCPTS(SDOE,SDARY) ; -- get cpt's for OLD encounter
+1 NEW SDIEN,SDCNT,Y,X,SDYARY
+2 DO COUNT(.SDOE,"SDYARY")
+3 SET (SDIEN,SDCNT)=0
+4 FOR
SET SDIEN=$ORDER(SDYARY(SDIEN))
if 'SDIEN
QUIT
Begin DoDot:1
+5 SET SDCNT=SDCNT+1
SET X=$GET(SDYARY(SDIEN))
+6 ; -- cpt ien
SET $PIECE(Y,U,1)=SDIEN
+7 ; -- quantity
SET $PIECE(Y,U,16)=+X
+8 SET @SDARY@(SDIEN)=Y
End DoDot:1
+9 SET @SDARY=SDCNT
+10 QUIT
+11 ;
COUNT(SDOE,SDZARY) ; -- count/find cpt's for OLD encounter
+1 NEW SDFN,SDATE,SDCL,SDT,SDSC,SDSC0,SDPR,SDPROC,I,SDOE0
+2 SET SDOE0=$GET(^SCE(SDOE,0))
+3 SET SDFN=+$PIECE(SDOE0,U,2)
+4 SET SDATE=+SDOE0
+5 SET SDCL=+$PIECE(SDOE0,U,4)
+6 SET SDT=+$GET(^SDV("ADT",SDFN,$PIECE(SDATE,".")))
+7 ;
+8 SET SDSC=0
FOR
SET SDSC=$ORDER(^SDV(SDT,"CS",SDSC))
if 'SDSC
QUIT
Begin DoDot:1
+9 SET SDSC0=$GET(^SDV(SDT,"CS",SDSC,0))
+10 SET SDPR=$GET(^SDV(SDT,"CS",SDSC,"PR"))
+11 ;
+12 ; -- only for clinic assoicated with encounter
+13 ; ('old' data lumped all cpts together for day)
+14 ;
+15 IF $PIECE($GET(^DIC(40.7,+SDSC0,0)),U,2)=900
IF $PIECE(SDSC0,U,3)=SDCL
Begin DoDot:2
+16 ; F I=1:1:5 S SDPROC=+$P(SDPR,U,I) IF $D(^ICPT(SDPROC,0)) S @SDZARY@(SDPROC)=$G(@SDZARY@(SDPROC))+1
+17 FOR I=1:1:5
SET SDPROC=+$PIECE(SDPR,U,I)
IF $$CPT^ICPTCOD(SDPROC,,1)>0
SET @SDZARY@(SDPROC)=$GET(@SDZARY@(SDPROC))+1
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
