source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDOECPT.m@ 1416

Last change on this file since 1416 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1SDOECPT ;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 ;
6CPT(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))
18CPTQ Q SDOK
19 ;
20 ;
21GETCPT(SDOE,SDCPT,SDERR) ; -- SDOE GET PROCEDURES
22 ; API ID: 61
23 ;
24 ;
25GETCPTG ; -- 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))
37GETCPTQ Q
38 ;
39 ;
40FINDCPT(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
54FINDCPTQ Q SDOK
55 ;
56 ;
57VALCPT(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 ;
71OLDCPT(SDOE) ; -- at least one cpt for OLD encounter?
72 N SDXARY
73 D OLDCPTS(SDOE,"SDXARY")
74 Q (+$G(SDXARY)>0)
75 ;
76OLDCPTS(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 ;
88COUNT(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 ;
Note: See TracBrowser for help on using the repository browser.