| [613] | 1 | SDOECPT ;ALB/MJK - ACRP CPT APIs For An Encounter ;8/12/96
|
|---|
| 2 | ;;5.3;Scheduling;**131,196**;Aug 13, 1993
|
|---|
| 3 | ;06/22/99 ACS - Added CPT modifier API calls
|
|---|
| 4 | ;06/22/99 ACS - Added CPT modifier logic for the AMB CARE toolkit
|
|---|
| 5 | ;
|
|---|
| 6 | CPT(SDOE,SDERR) ; -- SDOE ASSIGNED A PROCEDURE
|
|---|
| 7 | ; API ID: 65
|
|---|
| 8 | ;
|
|---|
| 9 | ;
|
|---|
| 10 | N SDOK
|
|---|
| 11 | S SDOK=0
|
|---|
| 12 | ;
|
|---|
| 13 | ; -- do validation checks
|
|---|
| 14 | IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G CPTQ
|
|---|
| 15 | IF $$OLD^SDOEUT(SDOE) S SDOK=$$OLDCPT(SDOE) G CPTQ
|
|---|
| 16 | ;
|
|---|
| 17 | S SDOK=$$CPT^PXAPIOE($$VIEN^SDOEUT(.SDOE),$G(SDERR))
|
|---|
| 18 | CPTQ Q SDOK
|
|---|
| 19 | ;
|
|---|
| 20 | ;
|
|---|
| 21 | GETCPT(SDOE,SDCPT,SDERR) ; -- SDOE GET PROCEDURES
|
|---|
| 22 | ; API ID: 61
|
|---|
| 23 | ;
|
|---|
| 24 | ;
|
|---|
| 25 | GETCPTG ; -- goto entry point
|
|---|
| 26 | ; -- do validation checks
|
|---|
| 27 | IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G GETCPTQ
|
|---|
| 28 | IF $$OLD^SDOEUT(SDOE) D OLDCPTS(SDOE,.SDCPT) G GETCPTQ
|
|---|
| 29 | ;
|
|---|
| 30 | ;D GETCPT^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDCPT,$G(SDERR))
|
|---|
| 31 | N MODNODE
|
|---|
| 32 | D CPTARR^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDCPT,$G(SDERR))
|
|---|
| 33 | S MODNODE=0
|
|---|
| 34 | ;
|
|---|
| 35 | ; spin through array VAFPROC built from global file ^AUPNVCPT
|
|---|
| 36 | F S MODNODE=+$O(@SDCPT@(MODNODE)) Q:'MODNODE S @SDCPT@(MODNODE)=$G(@SDCPT@(MODNODE,0))
|
|---|
| 37 | GETCPTQ Q
|
|---|
| 38 | ;
|
|---|
| 39 | ;
|
|---|
| 40 | FINDCPT(SDOE,SDCPTID,SDERR) ; -- SDOE FIND PROCEDURE
|
|---|
| 41 | ; API ID: 71
|
|---|
| 42 | ;
|
|---|
| 43 | ;
|
|---|
| 44 | N SDCPTS,SDOK,I
|
|---|
| 45 | S SDCPTS="SDCPTS"
|
|---|
| 46 | ;
|
|---|
| 47 | ; -- do validation checks
|
|---|
| 48 | IF '$$VALCPT(.SDCPTID,$G(SDERR)) S SDOK=0 G FINDCPTQ
|
|---|
| 49 | ;
|
|---|
| 50 | ;D GETCPT(.SDOE,.SDCPTS,$G(SDERR))
|
|---|
| 51 | D GETCPT(.SDOE,SDCPTS,$G(SDERR))
|
|---|
| 52 | S (I,SDOK)=0
|
|---|
| 53 | F S I=$O(SDCPTS(I)) Q:'I S SDOK=(+SDCPTS(I)=SDCPTID) Q:SDOK
|
|---|
| 54 | FINDCPTQ Q SDOK
|
|---|
| 55 | ;
|
|---|
| 56 | ;
|
|---|
| 57 | VALCPT(SDCPTID,SDERR) ; -- validate CPT input
|
|---|
| 58 | ;
|
|---|
| 59 | ; -- do checks
|
|---|
| 60 | ;IF SDCPTID,$D(^ICPT(SDCPTID,0)) Q 1
|
|---|
| 61 | IF SDCPTID,$$CPT^ICPTCOD(SDCPTID,,1)>0 Q 1
|
|---|
| 62 | ;
|
|---|
| 63 | ; -- build error msg
|
|---|
| 64 | N SDIN,SDOUT
|
|---|
| 65 | S SDIN("ID")=SDCPTID
|
|---|
| 66 | S SDOUT("ID")=SDCPTID
|
|---|
| 67 | D BLD^SDQVAL(4096800.005,.SDIN,.SDOUT,$G(SDERR))
|
|---|
| 68 | Q 0
|
|---|
| 69 | ;
|
|---|
| 70 | ;
|
|---|
| 71 | OLDCPT(SDOE) ; -- at least one cpt for OLD encounter?
|
|---|
| 72 | N SDXARY
|
|---|
| 73 | D OLDCPTS(SDOE,"SDXARY")
|
|---|
| 74 | Q (+$G(SDXARY)>0)
|
|---|
| 75 | ;
|
|---|
| 76 | OLDCPTS(SDOE,SDARY) ; -- get cpt's for OLD encounter
|
|---|
| 77 | N SDIEN,SDCNT,Y,X,SDYARY
|
|---|
| 78 | D COUNT(.SDOE,"SDYARY")
|
|---|
| 79 | S (SDIEN,SDCNT)=0
|
|---|
| 80 | F S SDIEN=$O(SDYARY(SDIEN)) Q:'SDIEN D
|
|---|
| 81 | . S SDCNT=SDCNT+1,X=$G(SDYARY(SDIEN))
|
|---|
| 82 | . S $P(Y,U,1)=SDIEN ; -- cpt ien
|
|---|
| 83 | . S $P(Y,U,16)=+X ; -- quantity
|
|---|
| 84 | . S @SDARY@(SDIEN)=Y
|
|---|
| 85 | S @SDARY=SDCNT
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | COUNT(SDOE,SDZARY) ; -- count/find cpt's for OLD encounter
|
|---|
| 89 | N SDFN,SDATE,SDCL,SDT,SDSC,SDSC0,SDPR,SDPROC,I,SDOE0
|
|---|
| 90 | S SDOE0=$G(^SCE(SDOE,0))
|
|---|
| 91 | S SDFN=+$P(SDOE0,U,2)
|
|---|
| 92 | S SDATE=+SDOE0
|
|---|
| 93 | S SDCL=+$P(SDOE0,U,4)
|
|---|
| 94 | S SDT=+$G(^SDV("ADT",SDFN,$P(SDATE,".")))
|
|---|
| 95 | ;
|
|---|
| 96 | S SDSC=0 F S SDSC=$O(^SDV(SDT,"CS",SDSC)) Q:'SDSC D
|
|---|
| 97 | . S SDSC0=$G(^SDV(SDT,"CS",SDSC,0))
|
|---|
| 98 | . S SDPR=$G(^SDV(SDT,"CS",SDSC,"PR"))
|
|---|
| 99 | .;
|
|---|
| 100 | .; -- only for clinic assoicated with encounter
|
|---|
| 101 | .; ('old' data lumped all cpts together for day)
|
|---|
| 102 | .;
|
|---|
| 103 | . IF $P($G(^DIC(40.7,+SDSC0,0)),U,2)=900,$P(SDSC0,U,3)=SDCL D
|
|---|
| 104 | ..; F I=1:1:5 S SDPROC=+$P(SDPR,U,I) IF $D(^ICPT(SDPROC,0)) S @SDZARY@(SDPROC)=$G(@SDZARY@(SDPROC))+1
|
|---|
| 105 | .. F I=1:1:5 S SDPROC=+$P(SDPR,U,I) IF $$CPT^ICPTCOD(SDPROC,,1)>0 S @SDZARY@(SDPROC)=$G(@SDZARY@(SDPROC))+1
|
|---|
| 106 | Q
|
|---|
| 107 | ;
|
|---|
