SDOERPC ;ALB/MJK - ACRP RPCs For An Encounter ;8/12/96
;;5.3;Scheduling;**131,196**;Aug 13, 1993
;06/22/99 ACS - Added CPT modifier logic for the AMB CARE toolkit
;
; ------------------------- cpt rpcs --------------------------
;
CPT(SDOEY,SDOE) ; -- SDOE ASSIGNED A PROCEDURE [API ID: 65]
S SDOEY=$$CPT^SDOECPT(SDOE)
Q
;
GETCPT(SDOEY,SDOE) ; -- SDOE GET PROCEDURES [API ID: 61]
D GETCPT^SDOECPT(.SDOE,"SDOEY")
;
; The following logic will remove the 2nd level subscripts
; (containing modifier information) from the CPT array because they
; aren't relevant for this routine
N LEVEL1,LEVEL2
S (LEVEL1,LEVEL2)=""
F S LEVEL1=$O(SDOEY(LEVEL1)) Q:'LEVEL1 D
. F S LEVEL2=$O(SDOEY(LEVEL1,LEVEL2)) Q:LEVEL2="" D
.. K SDOEY(LEVEL1,LEVEL2)
.. Q
. Q
Q
;
FINDCPT(SDOEY,SDOE,SDCPTID) ; -- SDOE FIND PROCEDURE [API ID: 71]
S SDOEY=$$FINDCPT^SDOECPT(SDOE,SDCPTID)
Q
;
; ------------------------- dx rpcs --------------------------
;
DX(SDOEY,SDOE) ; -- SDOE ASSIGNED A DIAGNOSIS [API ID: 64]
S SDOEY=$$DX^SDOEDX(SDOE)
Q
;
GETDX(SDOEY,SDOE) ; -- SDOE GET DIAGNOSES [API ID: 56]
D GETDX^SDOEDX(.SDOE,"SDOEY")
Q
;
FINDDX(SDOEY,SDOE,SDDXID) ; -- SDOE FIND DIAGNOSIS [API ID: 70]
S SDOEY=$$FINDDX^SDOEDX(SDOE,SDDXID)
Q
;
GETPDX(SDOEY,SDOE) ; -- SDOE GET PRIMARY DIAGNOSIS [API ID: 73]
S SDOEY=$$GETPDX^SDOEDX(SDOE)
Q
;
; ------------------------- provider rpcs --------------------------
;
PRV(SDOEY,SDOE) ; -- SDOE ASSIGNED A PROVIDER [API ID: 63]
S SDOEY=$$PRV^SDOEPRV(SDOE)
Q
;
GETPRV(SDOEY,SDOE) ; -- SDOE GET PROVIDERS [API ID: 58]
D GETPRV^SDOEPRV(.SDOE,"SDOEY")
Q
;
FINDPRV(SDOEY,SDOE,SDPRVID) ; -- SDOE FIND PROVIDER [API ID: 69]
S SDOEY=$$FINDPRV^SDOEPRV(SDOE,SDPRVID)
Q
;
; --------------------------------oe rpcs--------------------------
;
GETOE(SDOEY,SDOE) ; -- SDOE GET ZERO NODE [API ID: 98]
S SDOEY=$$GETOE^SDOEOE(SDOE)
Q
;
GETGEN(SDOEY,SDOE) ; -- SDOE GET GENERAL DATA [API ID: 76]
N SDAT,SDATAOE
S SDAT="SDATAOE"
D GETGEN^SDOEOE(.SDOE,.SDAT)
D BUILD(.SDATAOE,.SDOEY)
Q
;
PARSE(SDOEY,SDATA,SDFMT) ; -- SDOE PARSE GENERAL DATA [API ID: 78]
N SDY
S SDY="SDATAOE"
D PARSE^SDOEOE(.SDATA,.SDFMT,.SDY)
D BUILD(.SDATAOE,.SDOEY)
Q
;
EXAE(SDOEY,DFN,SDBEG,SDEND,SDFLAGS) ; -- SDOE FIND FIRST STANDALONE [API ID: 72]
S SDOEY=$$EXAE^SDOEOE(.DFN,.SDBEG,.SDEND,$G(SDFLAGS))
Q
;
GETLAST(SDOEY,DFN,SDBEG,SDFLAGS) ; -- SDOE FIND LAST STANDALONE [API ID: 75]
S SDOEY=$$GETLAST^SDOEOE(.DFN,.SDBEG,$G(SDFLAGS))
Q
;
EXOE(SDOEY,DFN,SDBEG,SDEND,SDFLAGS) ; -- SDOE FIND FIRST ENCOUNTER [API ID: 74]
S SDOEY=$$EXOE^SDOEOE(.DFN,.SDBEG,.SDEND,$G(SDFLAGS))
Q
;
;
LIST(SDOEY,SDBEG,SDEND) ; -- RPC: SDOE LIST ENCOUNTERS FOR DATES
N SDQID
D OPEN(.SDOEY,.SDQID)
IF '$$ERRCHK^SDQUT() D INDEX^SDQ(.SDQID,"DATE/TIME","SET")
IF '$$ERRCHK^SDQUT() D DATE^SDQ(.SDQID,SDBEG,SDEND,"SET")
D CLOSE(.SDQID)
LISTQ Q
;
LISTPAT(SDOEY,SDFN,SDBEG,SDEND) ; -- RPC: SDOE LIST ENCOUNTERS FOR PAT
N SDQID
D OPEN(.SDOEY,.SDQID)
IF '$$ERRCHK^SDQUT() D INDEX^SDQ(.SDQID,"PATIENT/DATE","SET")
IF '$$ERRCHK^SDQUT() D PAT^SDQ(.SDQID,SDFN,"SET")
IF '$$ERRCHK^SDQUT() D DATE^SDQ(.SDQID,SDBEG,SDEND,"SET")
D CLOSE(.SDQID)
LISTPATQ Q
;
LISTVST(SDOEY,SDVST) ; -- RPC: SDOE LIST ENCOUNTERS FOR VISIT
N SDQID
D OPEN(.SDOEY,.SDQID)
IF '$$ERRCHK^SDQUT() D INDEX^SDQ(.SDQID,"VISIT","SET")
IF '$$ERRCHK^SDQUT() D VISIT^SDQ(.SDQID,SDVST,"SET")
D CLOSE(.SDQID)
LISTVSTQ Q
;
OPEN(SDOEY,SDQID) ; -- initialize query
S SDOEY=$NA(^TMP("SD ENCOUNTER LIST",$J))
K ^TMP("SD ENCOUNTER LIST",$J)
D OPEN^SDQ(.SDQID)
OPENQ Q
;
CLOSE(SDQID) ; -- finalize query + scan + close
IF '$$ERRCHK^SDQUT() D SCANCB^SDQ(.SDQID,"D CB^SDOERPC(Y,Y0,.SDSTOP)","SET")
IF '$$ERRCHK^SDQUT() D ACTIVE^SDQ(.SDQID,"TRUE","SET")
IF '$$ERRCHK^SDQUT() D SCAN^SDQ(.SDQID)
D CLOSE^SDQ(.SDQID)
CLOSEQ Q
;
CB(SDOE,SDOE0,SDSTOP) ; -- callback for LIST* tags
S ^TMP("SD ENCOUNTER LIST",$J,SDOE)=SDOE_";;"_SDOE0
Q
;
BUILD(IN,OUT) ; -- build array for rpc lists
N IEN
S IEN=""
F S IEN=$O(IN(IEN)) Q:IEN="" S OUT(IEN)=IEN_";;"_IN(IEN)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDOERPC 4321 printed Nov 22, 2024@18:09 Page 2
SDOERPC ;ALB/MJK - ACRP RPCs For An Encounter ;8/12/96
+1 ;;5.3;Scheduling;**131,196**;Aug 13, 1993
+2 ;06/22/99 ACS - Added CPT modifier logic for the AMB CARE toolkit
+3 ;
+4 ; ------------------------- cpt rpcs --------------------------
+5 ;
CPT(SDOEY,SDOE) ; -- SDOE ASSIGNED A PROCEDURE [API ID: 65]
+1 SET SDOEY=$$CPT^SDOECPT(SDOE)
+2 QUIT
+3 ;
GETCPT(SDOEY,SDOE) ; -- SDOE GET PROCEDURES [API ID: 61]
+1 DO GETCPT^SDOECPT(.SDOE,"SDOEY")
+2 ;
+3 ; The following logic will remove the 2nd level subscripts
+4 ; (containing modifier information) from the CPT array because they
+5 ; aren't relevant for this routine
+6 NEW LEVEL1,LEVEL2
+7 SET (LEVEL1,LEVEL2)=""
+8 FOR
SET LEVEL1=$ORDER(SDOEY(LEVEL1))
if 'LEVEL1
QUIT
Begin DoDot:1
+9 FOR
SET LEVEL2=$ORDER(SDOEY(LEVEL1,LEVEL2))
if LEVEL2=""
QUIT
Begin DoDot:2
+10 KILL SDOEY(LEVEL1,LEVEL2)
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
FINDCPT(SDOEY,SDOE,SDCPTID) ; -- SDOE FIND PROCEDURE [API ID: 71]
+1 SET SDOEY=$$FINDCPT^SDOECPT(SDOE,SDCPTID)
+2 QUIT
+3 ;
+4 ; ------------------------- dx rpcs --------------------------
+5 ;
DX(SDOEY,SDOE) ; -- SDOE ASSIGNED A DIAGNOSIS [API ID: 64]
+1 SET SDOEY=$$DX^SDOEDX(SDOE)
+2 QUIT
+3 ;
GETDX(SDOEY,SDOE) ; -- SDOE GET DIAGNOSES [API ID: 56]
+1 DO GETDX^SDOEDX(.SDOE,"SDOEY")
+2 QUIT
+3 ;
FINDDX(SDOEY,SDOE,SDDXID) ; -- SDOE FIND DIAGNOSIS [API ID: 70]
+1 SET SDOEY=$$FINDDX^SDOEDX(SDOE,SDDXID)
+2 QUIT
+3 ;
GETPDX(SDOEY,SDOE) ; -- SDOE GET PRIMARY DIAGNOSIS [API ID: 73]
+1 SET SDOEY=$$GETPDX^SDOEDX(SDOE)
+2 QUIT
+3 ;
+4 ; ------------------------- provider rpcs --------------------------
+5 ;
PRV(SDOEY,SDOE) ; -- SDOE ASSIGNED A PROVIDER [API ID: 63]
+1 SET SDOEY=$$PRV^SDOEPRV(SDOE)
+2 QUIT
+3 ;
GETPRV(SDOEY,SDOE) ; -- SDOE GET PROVIDERS [API ID: 58]
+1 DO GETPRV^SDOEPRV(.SDOE,"SDOEY")
+2 QUIT
+3 ;
FINDPRV(SDOEY,SDOE,SDPRVID) ; -- SDOE FIND PROVIDER [API ID: 69]
+1 SET SDOEY=$$FINDPRV^SDOEPRV(SDOE,SDPRVID)
+2 QUIT
+3 ;
+4 ; --------------------------------oe rpcs--------------------------
+5 ;
GETOE(SDOEY,SDOE) ; -- SDOE GET ZERO NODE [API ID: 98]
+1 SET SDOEY=$$GETOE^SDOEOE(SDOE)
+2 QUIT
+3 ;
GETGEN(SDOEY,SDOE) ; -- SDOE GET GENERAL DATA [API ID: 76]
+1 NEW SDAT,SDATAOE
+2 SET SDAT="SDATAOE"
+3 DO GETGEN^SDOEOE(.SDOE,.SDAT)
+4 DO BUILD(.SDATAOE,.SDOEY)
+5 QUIT
+6 ;
PARSE(SDOEY,SDATA,SDFMT) ; -- SDOE PARSE GENERAL DATA [API ID: 78]
+1 NEW SDY
+2 SET SDY="SDATAOE"
+3 DO PARSE^SDOEOE(.SDATA,.SDFMT,.SDY)
+4 DO BUILD(.SDATAOE,.SDOEY)
+5 QUIT
+6 ;
EXAE(SDOEY,DFN,SDBEG,SDEND,SDFLAGS) ; -- SDOE FIND FIRST STANDALONE [API ID: 72]
+1 SET SDOEY=$$EXAE^SDOEOE(.DFN,.SDBEG,.SDEND,$GET(SDFLAGS))
+2 QUIT
+3 ;
GETLAST(SDOEY,DFN,SDBEG,SDFLAGS) ; -- SDOE FIND LAST STANDALONE [API ID: 75]
+1 SET SDOEY=$$GETLAST^SDOEOE(.DFN,.SDBEG,$GET(SDFLAGS))
+2 QUIT
+3 ;
EXOE(SDOEY,DFN,SDBEG,SDEND,SDFLAGS) ; -- SDOE FIND FIRST ENCOUNTER [API ID: 74]
+1 SET SDOEY=$$EXOE^SDOEOE(.DFN,.SDBEG,.SDEND,$GET(SDFLAGS))
+2 QUIT
+3 ;
+4 ;
LIST(SDOEY,SDBEG,SDEND) ; -- RPC: SDOE LIST ENCOUNTERS FOR DATES
+1 NEW SDQID
+2 DO OPEN(.SDOEY,.SDQID)
+3 IF '$$ERRCHK^SDQUT()
DO INDEX^SDQ(.SDQID,"DATE/TIME","SET")
+4 IF '$$ERRCHK^SDQUT()
DO DATE^SDQ(.SDQID,SDBEG,SDEND,"SET")
+5 DO CLOSE(.SDQID)
LISTQ QUIT
+1 ;
LISTPAT(SDOEY,SDFN,SDBEG,SDEND) ; -- RPC: SDOE LIST ENCOUNTERS FOR PAT
+1 NEW SDQID
+2 DO OPEN(.SDOEY,.SDQID)
+3 IF '$$ERRCHK^SDQUT()
DO INDEX^SDQ(.SDQID,"PATIENT/DATE","SET")
+4 IF '$$ERRCHK^SDQUT()
DO PAT^SDQ(.SDQID,SDFN,"SET")
+5 IF '$$ERRCHK^SDQUT()
DO DATE^SDQ(.SDQID,SDBEG,SDEND,"SET")
+6 DO CLOSE(.SDQID)
LISTPATQ QUIT
+1 ;
LISTVST(SDOEY,SDVST) ; -- RPC: SDOE LIST ENCOUNTERS FOR VISIT
+1 NEW SDQID
+2 DO OPEN(.SDOEY,.SDQID)
+3 IF '$$ERRCHK^SDQUT()
DO INDEX^SDQ(.SDQID,"VISIT","SET")
+4 IF '$$ERRCHK^SDQUT()
DO VISIT^SDQ(.SDQID,SDVST,"SET")
+5 DO CLOSE(.SDQID)
LISTVSTQ QUIT
+1 ;
OPEN(SDOEY,SDQID) ; -- initialize query
+1 SET SDOEY=$NAME(^TMP("SD ENCOUNTER LIST",$JOB))
+2 KILL ^TMP("SD ENCOUNTER LIST",$JOB)
+3 DO OPEN^SDQ(.SDQID)
OPENQ QUIT
+1 ;
CLOSE(SDQID) ; -- finalize query + scan + close
+1 IF '$$ERRCHK^SDQUT()
DO SCANCB^SDQ(.SDQID,"D CB^SDOERPC(Y,Y0,.SDSTOP)","SET")
+2 IF '$$ERRCHK^SDQUT()
DO ACTIVE^SDQ(.SDQID,"TRUE","SET")
+3 IF '$$ERRCHK^SDQUT()
DO SCAN^SDQ(.SDQID)
+4 DO CLOSE^SDQ(.SDQID)
CLOSEQ QUIT
+1 ;
CB(SDOE,SDOE0,SDSTOP) ; -- callback for LIST* tags
+1 SET ^TMP("SD ENCOUNTER LIST",$JOB,SDOE)=SDOE_";;"_SDOE0
+2 QUIT
+3 ;
BUILD(IN,OUT) ; -- build array for rpc lists
+1 NEW IEN
+2 SET IEN=""
+3 FOR
SET IEN=$ORDER(IN(IEN))
if IEN=""
QUIT
SET OUT(IEN)=IEN_";;"_IN(IEN)
+4 QUIT
+5 ;
