245 lines
9.4 KiB
Mathematica
245 lines
9.4 KiB
Mathematica
LRBEBAO ;DALOI/JAH/FHS - ORDERING AND RESULTING FOR OUTPATIENTS ;8/10/04
|
|
;;5.2;LAB SERVICE;**291,359**;Sep 27, 1994
|
|
;
|
|
; This routine contains the subroutines that get the diagnosis pointers
|
|
; and indicators at order entry and result verification for outpatient.
|
|
;
|
|
; Reference to EN^DDIOL supported by IA #10142
|
|
; Reference to ^DIC supported by IA #10006
|
|
; Reference to $$GET1^DIQ supported by IA #2056
|
|
; Reference to ^DIR supported by IA #10026
|
|
; Reference to ^ICD9 supported by IA #10082
|
|
; Reference to ^DIC(9.4 supported by IA #10048
|
|
; Reference to ^DIC(81.3 supported by IA #2816
|
|
;
|
|
OPORD ; Outpatient Order Entry
|
|
;
|
|
; Input:
|
|
; LRBEDFN - Patient's DFN (#2)
|
|
; LRBESMP - Sample
|
|
; LRBESPC - Specimen
|
|
; LRBETST - Ordered Test
|
|
; LRBEDGX - Pointer to Diagnosis (#80)
|
|
; LRBEAR(LRBEDFN,"DOS") - Date of Service
|
|
; LRBEAR(LRBEDFN,"PAT") - Patient DFN (#2)
|
|
; LRBEAR(LRBEDFN,"POS") - Place of Service
|
|
; LRBEAR(LRBEDFN,"ORDGX") - Ordering or Resulting Diagnosis
|
|
; LRBEAR(LRBEDFN,"USR") - User
|
|
; LRBEAR(LRBEDFN,"ORDPRO") - Ordering Provider
|
|
; LRBEAR(LRBEDFN,"LRBEDGX",LRBESMP,LRBESPC,LRBETST,LRBEDGX)
|
|
; Piece Desc
|
|
; ----- ---------------------------------
|
|
; 1 - Diagnosis
|
|
; 2 - Unused (blank)
|
|
; 3 - Textual Description of Diagnosis
|
|
; 4 - Agent Orange
|
|
; 5 - Ionizing Radiation
|
|
; 6 - Service Connected Indicator
|
|
; 7 - Environmental Contaminamts
|
|
; 8 - MST (Military Sexual Tramua)
|
|
; 9 - Head and Neck Cancer
|
|
; 10 - Combat Veteran
|
|
;
|
|
; Output:
|
|
; LRBEAR1(VISIT,TST,LRBEPOV)=LRBEDGX
|
|
; VISIT - Pointer to VISIT (9000010) file
|
|
; TST - Ordered Test
|
|
; LRBEPOV - Pointer to V POV (#9000010.07) file
|
|
; LRBEDGX - Pointer to Diagnosis (#80)
|
|
EN ;
|
|
D INIT
|
|
S SUB1="ENCOUNTER",SUB2="DX/PL",SUB3="PROVIDER"
|
|
S LRBEDFN="" F S LRBEDFN=$O(LRBEAR(LRBEDFN)) Q:LRBEDFN="" D
|
|
.S LRBETM=$S($P($G(LRBECDT),".",2):LRBECDT,$G(LRCDT):LRCDT,1:DT)
|
|
.S LRBETM=$$PCETM(LRBETM)
|
|
.S ^TMP("LRPXAPI",$J,SUB1,1,"ENC D/T")=LRBETM
|
|
.S ^TMP("LRPXAPI",$J,SUB1,1,"DSS ID")=LROOS
|
|
.S ^TMP("LRPXAPI",$J,SUB1,1,"HOS LOC")=$G(LRBEAR(LRBEDFN,"POS"))
|
|
.S ^TMP("LRPXAPI",$J,SUB1,1,"PATIENT")=$G(LRBEAR(LRBEDFN,"PAT"))
|
|
.S ^TMP("LRPXAPI",$J,SUB1,1,"SERVICE CATEGORY")="X"
|
|
.S ^TMP("LRPXAPI",$J,SUB1,1,"ENCOUNTER TYPE")="A"
|
|
.S ^TMP("LRPXAPI",$J,SUB3,1,"NAME")=$G(LRBEAR(LRBEDFN,"ORDPRO"))
|
|
.S ^TMP("LRPXAPI",$J,SUB3,1,"PRIMARY")=1
|
|
.I $G(LRBEAR(LRBEDFN,"DEL")) D
|
|
..S ^TMP("LRPXAPI",$J,SUB1,1,"DELETE")=$G(LRBEAR(LRBEDFN,"DEL"))
|
|
.S LRBESMP=""
|
|
.F S LRBESMP=$O(LRBEAR(LRBEDFN,"LRBEDGX",LRBESMP)) Q:LRBESMP="" D
|
|
..S LRBESPC=""
|
|
..F S LRBESPC=+$O(LRBEAR(LRBEDFN,"LRBEDGX",LRBESMP,LRBESPC)) Q:LRBESPC<1 D
|
|
...D OPWRK
|
|
Q
|
|
;
|
|
OPWRK ; More Outpatient Work
|
|
N X,XX,B,BG,N,DX,LRBEDIA
|
|
;get all primary (n=1) and secondary (n=2) dx
|
|
S LRBETST="" F S LRBETST=$O(LRBECPT(LRBETST)) Q:'LRBETST D
|
|
. S LRBETNUM=0 F S LRBETNUM=$O(LRBECPT(LRBETST,LRBETNUM)) Q:LRBETNUM<1 D
|
|
. . S LRBEDGX=""
|
|
. . F S LRBEDGX=$O(LRBEAR(LRBEDFN,"LRBEDGX",LRBESMP,LRBESPC,LRBETST,LRBEDGX)) Q:LRBEDGX="" D
|
|
. . . S LRBEPTDT=$G(LRBEAR(LRBEDFN,"LRBEDGX",LRBESMP,LRBESPC,LRBETST,LRBEDGX))
|
|
. . . S N=$S($P(LRBEPTDT,U,11):1,1:2),X=$P(LRBEPTDT,U,4,10)
|
|
. . . ;collapse indicators for same dx
|
|
. . . S XX=$G(DX(N,LRBEDGX))
|
|
. . . F B=1:1:7 I $P(XX,U,B)'=1,$P(X,U,B)'="" S $P(XX,U,B)=$P(X,U,B)
|
|
. . . S DX(N,LRBEDGX)=XX
|
|
;set primary dx in PCE array
|
|
S LRBEDGX=""
|
|
F S LRBEDGX=$O(DX(1,LRBEDGX)) Q:LRBEDGX="" D
|
|
. S LRBEDIA=$G(LRBEDIA)+1,XX=DX(1,LRBEDGX)
|
|
. S ^TMP("LRPXAPI",$J,SUB2,LRBEDIA,"DIAGNOSIS")=LRBEDGX
|
|
. S ^TMP("LRPXAPI",$J,SUB2,LRBEDIA,"PRIMARY")=1
|
|
. F B=1:1:7 I $P(XX,U,B)'="" D
|
|
. . S BG=$$GETT(B)
|
|
. . I '$G(^TMP("LRPXAPI",$J,SUB2,LRBEDIA,BG)) S ^TMP("LRPXAPI",$J,SUB2,LRBEDIA,BG)=$P(XX,U,B)
|
|
. . ;collapse dx indicators into encounter node
|
|
. . I '$G(^TMP("LRPXAPI",$J,SUB1,1,$P(BG," ",2))) S ^TMP("LRPXAPI",$J,SUB1,1,$P(BG," ",2))=$P(XX,U,B)
|
|
;set secondary dx in PCE array
|
|
S LRBEDGX=""
|
|
F S LRBEDGX=$O(DX(2,LRBEDGX)) Q:LRBEDGX="" D
|
|
. S LRBEDIA=$G(LRBEDIA)+1,XX=DX(2,LRBEDGX)
|
|
. S ^TMP("LRPXAPI",$J,SUB2,LRBEDIA,"DIAGNOSIS")=LRBEDGX
|
|
. F B=1:1:7 I $P(XX,U,B)'="" D
|
|
. . S BG=$$GETT(B)
|
|
. . I '$G(^TMP("LRPXAPI",$J,SUB2,LRBEDIA,BG)) S ^TMP("LRPXAPI",$J,SUB2,LRBEDIA,BG)=$P(XX,U,B)
|
|
. . ;collapse dx indicators into encounter node
|
|
. . I '$G(^TMP("LRPXAPI",$J,SUB1,1,$P(BG," ",2))) S ^TMP("LRPXAPI",$J,SUB1,1,$P(BG," ",2))=$P(XX,U,B)
|
|
Q
|
|
;
|
|
GETT(X) ; Indicators for ^TMP
|
|
I '+X Q ""
|
|
Q "PL "_$S(X=1:"AO",X=2:"IR",X=3:"SC",X=4:"EC",X=5:"MST",X=6:"HNC",1:"CV")
|
|
;
|
|
OPRES(LRBEAR,LRBEAR1,LRODT,LRSN,LRBEVST) ; Outpatient Final Resulting
|
|
; Inputs:
|
|
; LRBEDN - Data Number of Test in #63 field 400
|
|
; LRBEAR(LRBEDFN,"VST") - Patient's Encounter Number #9000010
|
|
; LRBEAR(LRBEDFN,"LRBEDGX",LRBEDN)
|
|
; Piece Desc
|
|
; 1 - Procedure (CPT)
|
|
; 2 - Modifiers (Sub-delimited by "~")
|
|
; 3 - Diagnosis
|
|
; 4 - Diagnosis 2
|
|
; 5 - Diagnosis 3
|
|
; 6 - Diagnosis 4
|
|
; 7 - Event D/T (DOS)
|
|
; 8 - Encounter Provider
|
|
; 9 - Ordering Provider
|
|
; 10 - Quantity (Number of times procedure was performed)
|
|
; 11 - Place of Service
|
|
; Output:
|
|
; LRBEAR1(VISIT,TST,LRBEPOV)=LRBEDGX
|
|
; VISIT - Pointer to VISIT (9000010) file
|
|
; TST - Ordered Test
|
|
; LRBEPOV - Pointer to V POV (#9000010.07) file
|
|
; LRBEDGX - Pointer to Diagnosis (#80)
|
|
;
|
|
D INIT
|
|
N LRSWSTAT,LRSWDATE
|
|
S LRSWSTAT=$$SWSTAT^IBBAPI
|
|
S LRSWDATE=+$P(LRSWSTAT,U,2)
|
|
S LRSWSTAT=+$P(LRSWSTAT,U)
|
|
S SUB1="PROCEDURE"
|
|
I '$G(LRDBEDGX) D
|
|
. N LRX
|
|
. S (LRDBEDGX,LRX)=0
|
|
. F S LRX=$O(^LRO(69,LRODT,1,LRSN,2,LRX)) Q:LRX<1!($G(LRDBEDGX)) D
|
|
. . ;set a default diagnosis and sc/ei indicators
|
|
. . I $G(^LRO(69,LRODT,1,LRSN,2,LRX,2,1,0)) S LRDBEDGX=+^(0)
|
|
S LRBEDFN="" F S LRBEDFN=$O(LRBEAR(LRBEDFN)) Q:LRBEDFN="" D
|
|
. S LRI=0 F S LRI=$O(LRBEAR(LRBEDFN,"LRBEDGX",LRI)) Q:LRI<1 D
|
|
. . D OPWRK2
|
|
;microbiology results sent to PCE in LRCAPPH1
|
|
I $P($G(^LRO(68,$G(LRAA),0)),U,2)'="MI" D SEND
|
|
Q
|
|
SEND ; Send if procedure is defined
|
|
N LRLNOW,LRVX,PXALOOK,PXUCV
|
|
I '$G(^TMP("LRPXAPI",$J,"PROCEDURE",1,"PROCEDURE")) G END
|
|
I $G(^XTMP("LRPCELOG",0)) D
|
|
. F S LRLNOW=$$NOW^XLFDT Q:'$D(^XTMP("LRPCELOG",1,LRLNOW))
|
|
. N LRACCX,LRUIDX
|
|
. S LRACCX=$G(LRACC),LRUIDX=$G(LRUID)
|
|
. M ^XTMP("LRPCELOG",2,LRLNOW)=^TMP("LRPXAPI",$J)
|
|
. S ^XTMP("LRPCELOG",2,LRLNOW,0)=LRACCX_U_LRUIDX
|
|
S LRVX=$$DATA2PCE^PXAPI(INROOT,LRPKG,SRC,.LRBEVSIT,USR,ERRDIS)
|
|
I $D(^XTMP("LRPCELOG",2,+$G(LRLNOW),0)) D
|
|
. S $P(^XTMP("LRPCELOG",2,+$G(LRLNOW),0),U,3,4)=LRVX_U_LRBEVSIT
|
|
. M ^XTMP("LRPCELOG",2,LRLNOW)=^TMP("LRPXAPI",$J)
|
|
I $G(LRBEVSIT) D SVST^LRBEBA3(LRBEVSIT,"PCE",LRODT,LRSN)
|
|
END K ^TMP("LRPXAPI",$J),LRBETNUM
|
|
Q
|
|
;
|
|
OPWRK2 ; Outpatient Work Two
|
|
K LRBEPTDT
|
|
S LRBEDN=0 F S LRBEDN=+$O(LRBEAR(LRBEDFN,"LRBEDGX",LRI,LRBEDN)) Q:LRBEDN<1 D OPWRK3
|
|
Q
|
|
OPWRK3 ;
|
|
N JJ
|
|
S LRBEPTDT=$G(LRBEAR(LRBEDFN,"LRBEDGX",LRI,LRBEDN))
|
|
Q:'($L(LRBEPTDT))
|
|
I '$P(LRBEPTDT,U,3) D
|
|
.S $P(LRBEPTDT,U,3)=LRDBEDGX
|
|
.S JJ=$O(^TMP("LRPXAPI",$J,"DX/PL",99),-1)+1
|
|
.S ^TMP("LRPXAPI",$J,"DX/PL",JJ,"DIAGNOSIS")=LRDBEDGX
|
|
.I JJ=1 S ^TMP("LRPXAPI",$J,"DX/PL",JJ,"PRIMARY")=1
|
|
.E S ^TMP("LRPXAPI",$J,"DX/PL",JJ,"PRIMARY")=0
|
|
S LRBETNUM=$G(LRBETNUM)+1,LRBEIEN=LRSN_","_LRODT_","
|
|
I $P(LRBEPTDT,U,1)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"PROCEDURE")=$P(LRBEPTDT,U,1)
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"QTY")=1
|
|
I $P(LRBEPTDT,U,2)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"MODIFIERS",$P(LRBEPTDT,U,2))=""
|
|
I $P(LRBEPTDT,U,3)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"DIAGNOSIS")=$P(LRBEPTDT,U,3)
|
|
I $P(LRBEPTDT,U,4)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"DIAGNOSIS 2")=$P(LRBEPTDT,U,4)
|
|
I $P(LRBEPTDT,U,5)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"DIAGNOSIS 3")=$P(LRBEPTDT,U,5)
|
|
I $P(LRBEPTDT,U,6)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"DIAGNOSIS 4")=$P(LRBEPTDT,U,6)
|
|
I $P(LRBEPTDT,U,7)'="" D
|
|
. N LRBETM S LRBETM=$P(LRBEPTDT,U,7)
|
|
. S LRBETM=$$PCETM(LRBETM)
|
|
. S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"EVENT D/T")=LRBETM
|
|
I $P(LRBEPTDT,U,8)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"ENC PROVIDER")=$P(LRBEPTDT,U,8)
|
|
I $P(LRBEPTDT,U,9)>0 D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"ORD PROVIDER")=$P(LRBEPTDT,U,9)
|
|
I $P(LRBEPTDT,U,10)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"QTY")=$P(LRBEPTDT,U,10)
|
|
I $P(LRBEPTDT,U,12)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"DIAGNOSIS 5")=$P(LRBEPTDT,U,12)
|
|
I $P(LRBEPTDT,U,13)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"DIAGNOSIS 6")=$P(LRBEPTDT,U,13)
|
|
I $P(LRBEPTDT,U,14)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"DIAGNOSIS 7")=$P(LRBEPTDT,U,14)
|
|
I $P(LRBEPTDT,U,15)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"DIAGNOSIS 8")=$P(LRBEPTDT,U,15)
|
|
I $P(LRBEPTDT,U,16)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"ORD REFERENCE")=$P(LRBEPTDT,U,16)
|
|
I LRSWSTAT,($P(LRBETM,".")'<LRSWDATE) D
|
|
.S ^TMP("LRPXAPI",$J,"PROCEDURE",LRBETNUM,"DEPARTMENT")=108
|
|
I $P(LRBEPTDT,U,20)'="" D
|
|
.S ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"QTY")=$P(LRBEPTDT,U,20)
|
|
I $G(^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"DIAGNOSIS"))=0 K ^TMP("LRPXAPI",$J,SUB1,LRBETNUM,"DIAGNOSIS")
|
|
Q
|
|
;
|
|
INIT ;Setup PCE variables
|
|
S INROOT="^TMP(""LRPXAPI"",$J)"
|
|
I '$G(LRPKG) D Q:'$G(LRPKG)
|
|
. S X="LAB SERVICE",DIC="^DIC(9.4,",DIC(0)="Z" D ^DIC
|
|
. I Y S LRPKG=+Y
|
|
S SRC="LAB DATA",USR=DUZ,(LRBETNUM,ERRDIS)=0
|
|
K DIC
|
|
Q
|
|
PCETM(LRBETM) ;Return date/time without seconds
|
|
N PCETM
|
|
S LRBETM=$G(LRBETM)
|
|
Q:'LRBETM LRBETM
|
|
S PCETM=$E($P(LRBETM,".",2),1,4)
|
|
F Q:($L(PCETM)=4) S PCETM=PCETM_0
|
|
I PCETM>2359 S PCETM=2359
|
|
I $E(PCETM,3,4)>59 S PCETM=$E(PCETM,1,2)_59
|
|
I 'PCETM S PCETM="0001"
|
|
S $P(LRBETM,".",2)=PCETM
|
|
Q LRBETM
|