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