112 lines
2.6 KiB
Mathematica
112 lines
2.6 KiB
Mathematica
SDOEDX ;ALB/MJK - ACRP DX APIs For An Encounter ;8/12/96
|
|
;;5.3;Scheduling;**131**;Aug 13, 1993
|
|
;
|
|
DX(SDOE,SDERR) ; -- SDOE ASSIGNED A DIAGNOSIS
|
|
; API ID: 64
|
|
;
|
|
;
|
|
N SDOK
|
|
S SDOK=0
|
|
;
|
|
; -- do validation checks
|
|
IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G DXQ
|
|
IF $$OLD^SDOEUT(SDOE) S SDOK=$$OLDDX(SDOE) G DXQ
|
|
;
|
|
S SDOK=$$DX^PXAPIOE($$VIEN^SDOEUT(.SDOE),$G(SDERR))
|
|
DXQ Q SDOK
|
|
;
|
|
;
|
|
GETDX(SDOE,SDDX,SDERR) ; -- SDOE GET DIAGNOSES
|
|
; API ID: 56
|
|
;
|
|
;
|
|
GETDXG ; -- goto entry point
|
|
;
|
|
; -- do validation checks
|
|
IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G GETDXQ
|
|
IF $$OLD^SDOEUT(SDOE) D OLDDXS(SDOE,.SDDX) G GETDXQ
|
|
;
|
|
D GETDX^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDDX,$G(SDERR))
|
|
GETDXQ Q
|
|
;
|
|
;
|
|
FINDDX(SDOE,SDDXID,SDERR) ; -- SDOE FIND DIAGNOSIS
|
|
; API ID: 70
|
|
;
|
|
;
|
|
N SDDXS,SDOK,I
|
|
S SDDXS="SDDXS"
|
|
;
|
|
; -- do validation checks
|
|
IF '$$VALDX(.SDDXID,$G(SDERR)) S SDOK=0 G FINDDXQ
|
|
;
|
|
D GETDX(.SDOE,.SDDXS,$G(SDERR))
|
|
S (I,SDOK)=0
|
|
F S I=$O(SDDXS(I)) Q:'I S SDOK=(+SDDXS(I)=SDDXID) Q:SDOK
|
|
FINDDXQ Q SDOK
|
|
;
|
|
;
|
|
GETPDX(SDOE,SDERR) ; -- SDOE GET PRIMARY DIAGNOSIS
|
|
; API ID: 73
|
|
;
|
|
;
|
|
N SDDXS,I,SDPDX,CNT
|
|
S SDDXS="SDDXS"
|
|
D GETDX(.SDOE,.SDDXS,$G(SDERR))
|
|
;
|
|
; -- how many are primaries / kill secondaries from array
|
|
S (CNT,I)=0
|
|
F S I=$O(SDDXS(I)) Q:'I S X=$P(SDDXS(I),"^",12) S:X="P" CNT=CNT+1 K:X'="P" SDDXS(I)
|
|
S SDPDX=+$G(SDDXS(+$O(SDDXS(0))))
|
|
;
|
|
; -- check for too many primaries & build error msg
|
|
IF CNT>1 D
|
|
. N DFN,DFN0,SDIN,SDOUT,Y,I,VA
|
|
. ;
|
|
. S SDPDX=0
|
|
. S DFN=+$P($G(^SCE(+SDOE,0)),"^",2)
|
|
. S DFN0=$G(^DPT(DFN,0))
|
|
. D PID^VADPT6
|
|
. ;
|
|
. S SDIN("ID")=SDOE,SDOUT("ID")=SDOE
|
|
. S SDIN("DFN")=DFN,SDOUT("DFN")=DFN
|
|
. S SDIN("PATNAME")=$P(DFN0,"^"),SDOUT("PATNAME")=$P(DFN0,"^")
|
|
. S SDIN("PID")=VA("PID"),SDOUT("PID")=VA("PID")
|
|
. ;
|
|
. S I=0,Y=""
|
|
. F S I=$O(SDDX(I)) Q:'I S Y=$P($G(^ICD9(+SDDXS,0)),"^")_" "
|
|
. S SDIN("CODES")=Y,SDOUT("CODES")=Y
|
|
. ;
|
|
. D BLD^SDQVAL(4096800.025,.SDIN,.SDOUT,$G(SDERR))
|
|
;
|
|
GETPDXQ Q SDPDX
|
|
;
|
|
;
|
|
VALDX(SDDXID,SDERR) ; -- validate dx input
|
|
;
|
|
; -- do checks
|
|
IF SDDXID,$D(^ICD9(SDDXID,0)) Q 1
|
|
;
|
|
; -- build error msg
|
|
N SDIN,SDOUT
|
|
S SDIN("ID")=SDDXID
|
|
S SDOUT("ID")=SDDXID
|
|
D BLD^SDQVAL(4096800.004,.SDIN,.SDOUT,$G(SDERR))
|
|
Q 0
|
|
;
|
|
;
|
|
OLDDX(SDOE) ; -- at least one dx for OLD encounter?
|
|
Q ($O(^SDD(409.43,"OE",+SDOE,0))>0)
|
|
;
|
|
OLDDXS(SDOE,SDARY) ; -- get DX's for OLD encounter
|
|
N SDIEN,SDCNT,Y,X
|
|
S (SDIEN,SDCNT)=0
|
|
F S SDIEN=$O(^SDD(409.43,"OE",SDOE,SDIEN)) Q:'SDIEN D
|
|
. S SDCNT=SDCNT+1,X=$G(^SDD(409.43,SDIEN,0))
|
|
. S $P(Y,U,1)=+X ; -- dx ien
|
|
. S $P(Y,U,12)=$S($P(X,"^",3)=1:"P",1:"S") ; -- primary dx?
|
|
. S @SDARY@(SDIEN)=Y
|
|
S @SDARY=SDCNT
|
|
Q
|
|
;
|