Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDOECPT

SDOECPT.m

Go to the documentation of this file.
  1. SDOECPT ;ALB/MJK - ACRP CPT APIs For An Encounter ;8/12/96
  1. ;;5.3;Scheduling;**131,196**;Aug 13, 1993
  1. ;06/22/99 ACS - Added CPT modifier API calls
  1. ;06/22/99 ACS - Added CPT modifier logic for the AMB CARE toolkit
  1. ;
  1. CPT(SDOE,SDERR) ; -- SDOE ASSIGNED A PROCEDURE
  1. ; API ID: 65
  1. ;
  1. ;
  1. N SDOK
  1. S SDOK=0
  1. ;
  1. ; -- do validation checks
  1. IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G CPTQ
  1. IF $$OLD^SDOEUT(SDOE) S SDOK=$$OLDCPT(SDOE) G CPTQ
  1. ;
  1. S SDOK=$$CPT^PXAPIOE($$VIEN^SDOEUT(.SDOE),$G(SDERR))
  1. CPTQ Q SDOK
  1. ;
  1. ;
  1. GETCPT(SDOE,SDCPT,SDERR) ; -- SDOE GET PROCEDURES
  1. ; API ID: 61
  1. ;
  1. ;
  1. GETCPTG ; -- goto entry point
  1. ; -- do validation checks
  1. IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G GETCPTQ
  1. IF $$OLD^SDOEUT(SDOE) D OLDCPTS(SDOE,.SDCPT) G GETCPTQ
  1. ;
  1. ;D GETCPT^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDCPT,$G(SDERR))
  1. N MODNODE
  1. D CPTARR^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDCPT,$G(SDERR))
  1. S MODNODE=0
  1. ;
  1. ; spin through array VAFPROC built from global file ^AUPNVCPT
  1. F S MODNODE=+$O(@SDCPT@(MODNODE)) Q:'MODNODE S @SDCPT@(MODNODE)=$G(@SDCPT@(MODNODE,0))
  1. GETCPTQ Q
  1. ;
  1. ;
  1. FINDCPT(SDOE,SDCPTID,SDERR) ; -- SDOE FIND PROCEDURE
  1. ; API ID: 71
  1. ;
  1. ;
  1. N SDCPTS,SDOK,I
  1. S SDCPTS="SDCPTS"
  1. ;
  1. ; -- do validation checks
  1. IF '$$VALCPT(.SDCPTID,$G(SDERR)) S SDOK=0 G FINDCPTQ
  1. ;
  1. ;D GETCPT(.SDOE,.SDCPTS,$G(SDERR))
  1. D GETCPT(.SDOE,SDCPTS,$G(SDERR))
  1. S (I,SDOK)=0
  1. F S I=$O(SDCPTS(I)) Q:'I S SDOK=(+SDCPTS(I)=SDCPTID) Q:SDOK
  1. FINDCPTQ Q SDOK
  1. ;
  1. ;
  1. VALCPT(SDCPTID,SDERR) ; -- validate CPT input
  1. ;
  1. ; -- do checks
  1. ;IF SDCPTID,$D(^ICPT(SDCPTID,0)) Q 1
  1. IF SDCPTID,$$CPT^ICPTCOD(SDCPTID,,1)>0 Q 1
  1. ;
  1. ; -- build error msg
  1. N SDIN,SDOUT
  1. S SDIN("ID")=SDCPTID
  1. S SDOUT("ID")=SDCPTID
  1. D BLD^SDQVAL(4096800.005,.SDIN,.SDOUT,$G(SDERR))
  1. Q 0
  1. ;
  1. ;
  1. OLDCPT(SDOE) ; -- at least one cpt for OLD encounter?
  1. N SDXARY
  1. D OLDCPTS(SDOE,"SDXARY")
  1. Q (+$G(SDXARY)>0)
  1. ;
  1. OLDCPTS(SDOE,SDARY) ; -- get cpt's for OLD encounter
  1. N SDIEN,SDCNT,Y,X,SDYARY
  1. D COUNT(.SDOE,"SDYARY")
  1. S (SDIEN,SDCNT)=0
  1. F S SDIEN=$O(SDYARY(SDIEN)) Q:'SDIEN D
  1. . S SDCNT=SDCNT+1,X=$G(SDYARY(SDIEN))
  1. . S $P(Y,U,1)=SDIEN ; -- cpt ien
  1. . S $P(Y,U,16)=+X ; -- quantity
  1. . S @SDARY@(SDIEN)=Y
  1. S @SDARY=SDCNT
  1. Q
  1. ;
  1. COUNT(SDOE,SDZARY) ; -- count/find cpt's for OLD encounter
  1. N SDFN,SDATE,SDCL,SDT,SDSC,SDSC0,SDPR,SDPROC,I,SDOE0
  1. S SDOE0=$G(^SCE(SDOE,0))
  1. S SDFN=+$P(SDOE0,U,2)
  1. S SDATE=+SDOE0
  1. S SDCL=+$P(SDOE0,U,4)
  1. S SDT=+$G(^SDV("ADT",SDFN,$P(SDATE,".")))
  1. ;
  1. S SDSC=0 F S SDSC=$O(^SDV(SDT,"CS",SDSC)) Q:'SDSC D
  1. . S SDSC0=$G(^SDV(SDT,"CS",SDSC,0))
  1. . S SDPR=$G(^SDV(SDT,"CS",SDSC,"PR"))
  1. .;
  1. .; -- only for clinic assoicated with encounter
  1. .; ('old' data lumped all cpts together for day)
  1. .;
  1. . IF $P($G(^DIC(40.7,+SDSC0,0)),U,2)=900,$P(SDSC0,U,3)=SDCL D
  1. ..; F I=1:1:5 S SDPROC=+$P(SDPR,U,I) IF $D(^ICPT(SDPROC,0)) S @SDZARY@(SDPROC)=$G(@SDZARY@(SDPROC))+1
  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
  1. Q
  1. ;