| [613] | 1 | SDOEDX ;ALB/MJK - ACRP DX APIs For An Encounter ;8/12/96
|
|---|
| 2 | ;;5.3;Scheduling;**131**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | DX(SDOE,SDERR) ; -- SDOE ASSIGNED A DIAGNOSIS
|
|---|
| 5 | ; API ID: 64
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | N SDOK
|
|---|
| 9 | S SDOK=0
|
|---|
| 10 | ;
|
|---|
| 11 | ; -- do validation checks
|
|---|
| 12 | IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G DXQ
|
|---|
| 13 | IF $$OLD^SDOEUT(SDOE) S SDOK=$$OLDDX(SDOE) G DXQ
|
|---|
| 14 | ;
|
|---|
| 15 | S SDOK=$$DX^PXAPIOE($$VIEN^SDOEUT(.SDOE),$G(SDERR))
|
|---|
| 16 | DXQ Q SDOK
|
|---|
| 17 | ;
|
|---|
| 18 | ;
|
|---|
| 19 | GETDX(SDOE,SDDX,SDERR) ; -- SDOE GET DIAGNOSES
|
|---|
| 20 | ; API ID: 56
|
|---|
| 21 | ;
|
|---|
| 22 | ;
|
|---|
| 23 | GETDXG ; -- goto entry point
|
|---|
| 24 | ;
|
|---|
| 25 | ; -- do validation checks
|
|---|
| 26 | IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G GETDXQ
|
|---|
| 27 | IF $$OLD^SDOEUT(SDOE) D OLDDXS(SDOE,.SDDX) G GETDXQ
|
|---|
| 28 | ;
|
|---|
| 29 | D GETDX^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDDX,$G(SDERR))
|
|---|
| 30 | GETDXQ Q
|
|---|
| 31 | ;
|
|---|
| 32 | ;
|
|---|
| 33 | FINDDX(SDOE,SDDXID,SDERR) ; -- SDOE FIND DIAGNOSIS
|
|---|
| 34 | ; API ID: 70
|
|---|
| 35 | ;
|
|---|
| 36 | ;
|
|---|
| 37 | N SDDXS,SDOK,I
|
|---|
| 38 | S SDDXS="SDDXS"
|
|---|
| 39 | ;
|
|---|
| 40 | ; -- do validation checks
|
|---|
| 41 | IF '$$VALDX(.SDDXID,$G(SDERR)) S SDOK=0 G FINDDXQ
|
|---|
| 42 | ;
|
|---|
| 43 | D GETDX(.SDOE,.SDDXS,$G(SDERR))
|
|---|
| 44 | S (I,SDOK)=0
|
|---|
| 45 | F S I=$O(SDDXS(I)) Q:'I S SDOK=(+SDDXS(I)=SDDXID) Q:SDOK
|
|---|
| 46 | FINDDXQ Q SDOK
|
|---|
| 47 | ;
|
|---|
| 48 | ;
|
|---|
| 49 | GETPDX(SDOE,SDERR) ; -- SDOE GET PRIMARY DIAGNOSIS
|
|---|
| 50 | ; API ID: 73
|
|---|
| 51 | ;
|
|---|
| 52 | ;
|
|---|
| 53 | N SDDXS,I,SDPDX,CNT
|
|---|
| 54 | S SDDXS="SDDXS"
|
|---|
| 55 | D GETDX(.SDOE,.SDDXS,$G(SDERR))
|
|---|
| 56 | ;
|
|---|
| 57 | ; -- how many are primaries / kill secondaries from array
|
|---|
| 58 | S (CNT,I)=0
|
|---|
| 59 | 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)
|
|---|
| 60 | S SDPDX=+$G(SDDXS(+$O(SDDXS(0))))
|
|---|
| 61 | ;
|
|---|
| 62 | ; -- check for too many primaries & build error msg
|
|---|
| 63 | IF CNT>1 D
|
|---|
| 64 | . N DFN,DFN0,SDIN,SDOUT,Y,I,VA
|
|---|
| 65 | . ;
|
|---|
| 66 | . S SDPDX=0
|
|---|
| 67 | . S DFN=+$P($G(^SCE(+SDOE,0)),"^",2)
|
|---|
| 68 | . S DFN0=$G(^DPT(DFN,0))
|
|---|
| 69 | . D PID^VADPT6
|
|---|
| 70 | . ;
|
|---|
| 71 | . S SDIN("ID")=SDOE,SDOUT("ID")=SDOE
|
|---|
| 72 | . S SDIN("DFN")=DFN,SDOUT("DFN")=DFN
|
|---|
| 73 | . S SDIN("PATNAME")=$P(DFN0,"^"),SDOUT("PATNAME")=$P(DFN0,"^")
|
|---|
| 74 | . S SDIN("PID")=VA("PID"),SDOUT("PID")=VA("PID")
|
|---|
| 75 | . ;
|
|---|
| 76 | . S I=0,Y=""
|
|---|
| 77 | . F S I=$O(SDDX(I)) Q:'I S Y=$P($G(^ICD9(+SDDXS,0)),"^")_" "
|
|---|
| 78 | . S SDIN("CODES")=Y,SDOUT("CODES")=Y
|
|---|
| 79 | . ;
|
|---|
| 80 | . D BLD^SDQVAL(4096800.025,.SDIN,.SDOUT,$G(SDERR))
|
|---|
| 81 | ;
|
|---|
| 82 | GETPDXQ Q SDPDX
|
|---|
| 83 | ;
|
|---|
| 84 | ;
|
|---|
| 85 | VALDX(SDDXID,SDERR) ; -- validate dx input
|
|---|
| 86 | ;
|
|---|
| 87 | ; -- do checks
|
|---|
| 88 | IF SDDXID,$D(^ICD9(SDDXID,0)) Q 1
|
|---|
| 89 | ;
|
|---|
| 90 | ; -- build error msg
|
|---|
| 91 | N SDIN,SDOUT
|
|---|
| 92 | S SDIN("ID")=SDDXID
|
|---|
| 93 | S SDOUT("ID")=SDDXID
|
|---|
| 94 | D BLD^SDQVAL(4096800.004,.SDIN,.SDOUT,$G(SDERR))
|
|---|
| 95 | Q 0
|
|---|
| 96 | ;
|
|---|
| 97 | ;
|
|---|
| 98 | OLDDX(SDOE) ; -- at least one dx for OLD encounter?
|
|---|
| 99 | Q ($O(^SDD(409.43,"OE",+SDOE,0))>0)
|
|---|
| 100 | ;
|
|---|
| 101 | OLDDXS(SDOE,SDARY) ; -- get DX's for OLD encounter
|
|---|
| 102 | N SDIEN,SDCNT,Y,X
|
|---|
| 103 | S (SDIEN,SDCNT)=0
|
|---|
| 104 | F S SDIEN=$O(^SDD(409.43,"OE",SDOE,SDIEN)) Q:'SDIEN D
|
|---|
| 105 | . S SDCNT=SDCNT+1,X=$G(^SDD(409.43,SDIEN,0))
|
|---|
| 106 | . S $P(Y,U,1)=+X ; -- dx ien
|
|---|
| 107 | . S $P(Y,U,12)=$S($P(X,"^",3)=1:"P",1:"S") ; -- primary dx?
|
|---|
| 108 | . S @SDARY@(SDIEN)=Y
|
|---|
| 109 | S @SDARY=SDCNT
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
