ORWGAPIC ; SLC/STAFF - Graph Application Calls - Labs, Meds ;11/1/06 12:49
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
;
AA(IEN) ; $$(ien) -> external display of accession area
Q $P($G(^LRO(68,IEN,0)),U)
;
AALAB(TEST) ; $$(lab test) -> accession ien^acc name^acc abbrev
N AA,DIV
S TEST=+$G(TEST)
S DIV=+$G(DUZ(2))
S AA=+$P($G(^LAB(60,+TEST,8,DIV,0)),U,2)
I AA Q AA_U_$$ACCLAB(AA)
S AA=+$P($G(^LAB(60,+TEST,8,+$O(^LAB(60,+TEST,8,0)),0)),U,2)
I AA Q AA_U_$$ACCLAB(AA)
Q ""
;
ACC(DATA) ; API - get accession areas - from ORWGAPI
N CNT,IEN,TMP,RESULT,ZERO
D RETURN^ORWGAPIW(.TMP,.DATA)
S CNT=0
S IEN=0
F S IEN=$O(^LRO(68,IEN)) Q:IEN<1 D
. S ZERO=$G(^LRO(68,IEN,0)) I '$L(ZERO) Q
. S RESULT="68^"_IEN_U_$P(ZERO,U)_U_$P(ZERO,U,11)
. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
ACCLAB(AA) ; $$(accession ien) -> acc name^acc abbrev
N ZERO
S ZERO=$G(^LRO(68,AA,0)) I '$L(ZERO) Q ""
Q "lab - "_$P(ZERO,U)_U_$P(ZERO,U,11)
;
ADDDRUG(IEN) ; $$(additive) -> drug in 50 else ""
N RESULT K ^TMP($J,"RX")
I '$G(IEN) Q ""
D ZERO^PSS52P6(IEN,,,"RX")
S RESULT=$P($G(^TMP($J,"RX",IEN,1)),U)
K ^TMP($J,"RX")
Q RESULT
;
BCMAX(DFN) ; $$(dfn) -> 1 if patient has data else 0
Q $O(^PSB(53.79,"B",+$G(DFN),0))>0
;
DC(IEN) ; $$(ien) -> external display of drug class
N RESULT K ^TMP($J,"RX")
I '$G(IEN) Q ""
D IEN^PSN50P65(IEN,,"RX")
S RESULT=$G(^TMP($J,"RX",IEN,1))
K ^TMP($J,"RX")
Q RESULT
;
DRGCLASS(DRUG) ; $$(drug) -> drug class^classification
N RESULT K ^TMP($J,"RX")
I '$G(DRUG) Q ""
D DATA^PSS50(DRUG,,,,,"RX")
S RESULT=+$G(^TMP($J,"RX",DRUG,25))
K ^TMP($J,"RX")
Q RESULT_U_"drug - "_$$DC(RESULT)
;
DRUG(NUM) ; $$(bcma entry) -> drug in 50 else ""
N DONE,DRUG,NUM1
S DONE=0,NUM=+$G(NUM)
S NUM1=0
F S NUM1=$O(^PSB(53.79,NUM,.5,"B",NUM1)) Q:NUM1<1 S DONE=1 Q
I DONE Q NUM1
S DRUG=0
S NUM1=0
F S NUM1=$O(^PSB(53.79,NUM,.6,"B",NUM1)) Q:NUM1<1 D I DONE Q
. S DRUG=$$ADDDRUG(NUM1)
. I DRUG S DONE=1
I DONE Q DRUG
S DRUG=0
S NUM1=0
F S NUM1=$O(^PSB(53.79,NUM,.7,"B",NUM1)) Q:NUM1<1 D I DONE Q
. S DRUG=$$SOLDRUG(NUM1)
. I DRUG S DONE=1
I DONE Q DRUG
Q ""
;
DRUGC(VALUES) ; API - get drug classes - from ORWGAPI
N CLASS,IEN,NUM,ROOT K VALUES
S NUM=0
S ROOT=$$ROOT^PSN50P65(1)
S CLASS=""
F S CLASS=$O(@ROOT@(CLASS)) Q:CLASS="" D
. S IEN=0
. F S IEN=$O(@ROOT@(CLASS,IEN)) Q:IEN="" D
.. S NUM=NUM+1
.. S VALUES(NUM)="50.605^"_IEN_U_CLASS
M ^TMP("ORWGRPC",$J)=VALUES K VALUES
Q
;
INSIG(NODE) ; $$(node) -> sig
N SIG,SUB,VALUES K VALUES
S SUB=$P($G(NODE),";",2)
D RXIN(NODE,.VALUES)
S SIG=""
I SUB=5 D
. S SIG=" Give: "_$G(VALUES("MR"))
. S SIG=SIG_" "_$P($G(VALUES("SCH",1,0)),U)
. S SIG=SIG_" "_$P($G(VALUES("SCH",1,0)),U,2)
I SUB="IV" D
. S SIG=" Give: "_$G(VALUES("DO"))
. S SIG=SIG_" "_$$EXT^ORWGAPIX($G(VALUES("START")),55.01,.02)
. S SIG=SIG_" "_$G(VALUES("SCH",1,0))
Q SIG
;
LAB(ORVALUE,NODE,ITEM) ; from ORWGAPI3
D LRPXRM^LRPXAPI(.ORVALUE,NODE,ITEM,"VSC")
Q
;
LABNAME(Y) ; $$(item ien) -> item name
I $P(Y,";")="A",$P(Y,";",2)="S" Q $P(Y,".",2,99)
Q $$ITEMNM^LRPXAPIU(Y)
;
LABSUM(ORDATA,DFN,DATE1,DATE2,ORSUB) ; from ORWGAPID
D EN^LR7OSUM(.ORDATA,DFN,DATE1,DATE2,,80,.ORSUB)
Q
;
LRDFN(DFN) ; $$(dfn) -> lrdfn
Q $$LRDFN^LRPXAPIU(DFN)
;
LRIDT(LRDT) ; $$(date) -> inverse date
Q $$LRIDT^LRPXAPIU(LRDT)
;
NVASIG(NODE) ; $$(node) -> sig on non-va drug
N RESULTS,SIG K RESULTS
I '$L(NODE) Q ""
D RXNVA(NODE,.RESULTS)
S SIG=RESULTS("DOSAGE")
S SIG=SIG_" "_RESULTS("MEDICATION ROUTE")
S SIG=SIG_" "_RESULTS("SCHEDULE")
Q SIG
;
NVAX(DFN) ; $$(dfn) -> 1 if patient has data else 0
Q $L($O(^PXRMINDX("55NVA","PI",+$G(DFN),"")))>0
;
POINAME(IEN) ; $$(poi entry) - > name and dosage form else ""
N NAME,RESULT K ^TMP($J,"RX")
I '$G(IEN) Q ""
D ZERO^PSS50P7(IEN,,,"RX")
S NAME=$P($G(^TMP($J,"RX",IEN,.01)),U)
K ^TMP($J,"RX")
I NAME'=" " Q NAME
Q ""
;
RXIN(NODE,ORVALUE) ; from ORWGAPI3
D OEL^PSJPXRM1(NODE,.ORVALUE)
Q
;
RXNUM(DFN,RXIEN) ; $$(dfn,prescription ien) -> rx#
N RXNUM K ^TMP($J,"RX")
S RXIEN=+$G(RXIEN)
D RX^PSO52API(DFN,"RX",RXIEN,,0)
S RXNUM=$G(^TMP($J,"RX",DFN,RXIEN,.01))
I $L(RXNUM) S RXNUM=" RX#: "_+RXNUM
K ^TMP($J,"RX")
Q RXNUM
;
RXNVA(NODE,ORVALUE,XSTART,XSTOP) ; from ORWGAPI1, ORWGAPI3, ORWGAPID
S XSTART=1,XSTOP=1
D NVA^PSOPXRM1(NODE,.ORVALUE)
I '$G(ORVALUE("START DATE")) D
. S ORVALUE("START DATE")=$G(ORVALUE("DOCUMENTED DATE"))
. S XSTART=0
I '$G(ORVALUE("DISCONTINUED DATE")) D
. S XSTOP=0
Q
;
RXOUT(NODE,ORVALUE) ; from ORWGAPI3
D PSRX^PSOPXRM1(NODE,.ORVALUE)
Q
;
SIG(DFN,RXIEN) ; $$(dfn,prescription ien) -> sig
N LNUM,SIG K ^TMP($J,"RX")
S RXIEN=+$G(RXIEN)
D RX^PSO52API(DFN,"RX",RXIEN,,"M",,)
S SIG=""
S LNUM=0
F S LNUM=$O(^TMP($J,"RX",DFN,RXIEN,"M",LNUM)) Q:LNUM<1 D
. S SIG=SIG_$G(^TMP($J,"RX",DFN,RXIEN,"M",LNUM,0))_" "
I $L(SIG) S SIG=" Sig: "_$$LOW^ORWGAPIX(SIG)
K ^TMP($J,"RX")
Q SIG
;
SOLDRUG(IEN) ; $$(iv solution) -> drug in 50 else ""
N RESULT K ^TMP($J,"RX")
I '$G(IEN) Q ""
D ZERO^PSS52P7(IEN,,,"RX")
S RESULT=$P($G(^TMP($J,"RX",IEN,1)),U)
K ^TMP($J,"RX")
Q RESULT
;
TESTSPEC(DATA) ; from ORWGAPI
N CNT,LINE,TEST,TMP,SPEC
D RETURN^ORWGAPIW(.TMP,.DATA)
S CNT=0
S TEST=0
F S TEST=$O(^LAB(60,TEST)) Q:TEST<1 D
. S SPEC=0
. F S SPEC=$O(^LAB(60,TEST,1,SPEC)) Q:SPEC<1 D
.. S CNT=CNT+1
.. S LINE=TEST_U_$G(^LAB(60,TEST,1,SPEC,0))
.. I $P(LINE,U,3)[$C(34) S $P(LINE,U,3)=$$TRIM^ORWGAPIX($P(LINE,U,3),"LR",$C(34))
.. I $P(LINE,U,4)[$C(34) S $P(LINE,U,4)=$$TRIM^ORWGAPIX($P(LINE,U,4),"LR",$C(34))
.. I TMP S ^TMP(DATA,$J,CNT)=LINE Q
.. S DATA(CNT)=LINE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWGAPIC 5800 printed Apr 09, 2024@21:39:46 Page 2
ORWGAPIC ; SLC/STAFF - Graph Application Calls - Labs, Meds ;11/1/06 12:49
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
+2 ;
AA(IEN) ; $$(ien) -> external display of accession area
+1 QUIT $PIECE($GET(^LRO(68,IEN,0)),U)
+2 ;
AALAB(TEST) ; $$(lab test) -> accession ien^acc name^acc abbrev
+1 NEW AA,DIV
+2 SET TEST=+$GET(TEST)
+3 SET DIV=+$GET(DUZ(2))
+4 SET AA=+$PIECE($GET(^LAB(60,+TEST,8,DIV,0)),U,2)
+5 IF AA
QUIT AA_U_$$ACCLAB(AA)
+6 SET AA=+$PIECE($GET(^LAB(60,+TEST,8,+$ORDER(^LAB(60,+TEST,8,0)),0)),U,2)
+7 IF AA
QUIT AA_U_$$ACCLAB(AA)
+8 QUIT ""
+9 ;
ACC(DATA) ; API - get accession areas - from ORWGAPI
+1 NEW CNT,IEN,TMP,RESULT,ZERO
+2 DO RETURN^ORWGAPIW(.TMP,.DATA)
+3 SET CNT=0
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^LRO(68,IEN))
if IEN<1
QUIT
Begin DoDot:1
+6 SET ZERO=$GET(^LRO(68,IEN,0))
IF '$LENGTH(ZERO)
QUIT
+7 SET RESULT="68^"_IEN_U_$PIECE(ZERO,U)_U_$PIECE(ZERO,U,11)
+8 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:1
+9 QUIT
+10 ;
ACCLAB(AA) ; $$(accession ien) -> acc name^acc abbrev
+1 NEW ZERO
+2 SET ZERO=$GET(^LRO(68,AA,0))
IF '$LENGTH(ZERO)
QUIT ""
+3 QUIT "lab - "_$PIECE(ZERO,U)_U_$PIECE(ZERO,U,11)
+4 ;
ADDDRUG(IEN) ; $$(additive) -> drug in 50 else ""
+1 NEW RESULT
KILL ^TMP($JOB,"RX")
+2 IF '$GET(IEN)
QUIT ""
+3 DO ZERO^PSS52P6(IEN,,,"RX")
+4 SET RESULT=$PIECE($GET(^TMP($JOB,"RX",IEN,1)),U)
+5 KILL ^TMP($JOB,"RX")
+6 QUIT RESULT
+7 ;
BCMAX(DFN) ; $$(dfn) -> 1 if patient has data else 0
+1 QUIT $ORDER(^PSB(53.79,"B",+$GET(DFN),0))>0
+2 ;
DC(IEN) ; $$(ien) -> external display of drug class
+1 NEW RESULT
KILL ^TMP($JOB,"RX")
+2 IF '$GET(IEN)
QUIT ""
+3 DO IEN^PSN50P65(IEN,,"RX")
+4 SET RESULT=$GET(^TMP($JOB,"RX",IEN,1))
+5 KILL ^TMP($JOB,"RX")
+6 QUIT RESULT
+7 ;
DRGCLASS(DRUG) ; $$(drug) -> drug class^classification
+1 NEW RESULT
KILL ^TMP($JOB,"RX")
+2 IF '$GET(DRUG)
QUIT ""
+3 DO DATA^PSS50(DRUG,,,,,"RX")
+4 SET RESULT=+$GET(^TMP($JOB,"RX",DRUG,25))
+5 KILL ^TMP($JOB,"RX")
+6 QUIT RESULT_U_"drug - "_$$DC(RESULT)
+7 ;
DRUG(NUM) ; $$(bcma entry) -> drug in 50 else ""
+1 NEW DONE,DRUG,NUM1
+2 SET DONE=0
SET NUM=+$GET(NUM)
+3 SET NUM1=0
+4 FOR
SET NUM1=$ORDER(^PSB(53.79,NUM,.5,"B",NUM1))
if NUM1<1
QUIT
SET DONE=1
QUIT
+5 IF DONE
QUIT NUM1
+6 SET DRUG=0
+7 SET NUM1=0
+8 FOR
SET NUM1=$ORDER(^PSB(53.79,NUM,.6,"B",NUM1))
if NUM1<1
QUIT
Begin DoDot:1
+9 SET DRUG=$$ADDDRUG(NUM1)
+10 IF DRUG
SET DONE=1
End DoDot:1
IF DONE
QUIT
+11 IF DONE
QUIT DRUG
+12 SET DRUG=0
+13 SET NUM1=0
+14 FOR
SET NUM1=$ORDER(^PSB(53.79,NUM,.7,"B",NUM1))
if NUM1<1
QUIT
Begin DoDot:1
+15 SET DRUG=$$SOLDRUG(NUM1)
+16 IF DRUG
SET DONE=1
End DoDot:1
IF DONE
QUIT
+17 IF DONE
QUIT DRUG
+18 QUIT ""
+19 ;
DRUGC(VALUES) ; API - get drug classes - from ORWGAPI
+1 NEW CLASS,IEN,NUM,ROOT
KILL VALUES
+2 SET NUM=0
+3 SET ROOT=$$ROOT^PSN50P65(1)
+4 SET CLASS=""
+5 FOR
SET CLASS=$ORDER(@ROOT@(CLASS))
if CLASS=""
QUIT
Begin DoDot:1
+6 SET IEN=0
+7 FOR
SET IEN=$ORDER(@ROOT@(CLASS,IEN))
if IEN=""
QUIT
Begin DoDot:2
+8 SET NUM=NUM+1
+9 SET VALUES(NUM)="50.605^"_IEN_U_CLASS
End DoDot:2
End DoDot:1
+10 MERGE ^TMP("ORWGRPC",$JOB)=VALUES
KILL VALUES
+11 QUIT
+12 ;
INSIG(NODE) ; $$(node) -> sig
+1 NEW SIG,SUB,VALUES
KILL VALUES
+2 SET SUB=$PIECE($GET(NODE),";",2)
+3 DO RXIN(NODE,.VALUES)
+4 SET SIG=""
+5 IF SUB=5
Begin DoDot:1
+6 SET SIG=" Give: "_$GET(VALUES("MR"))
+7 SET SIG=SIG_" "_$PIECE($GET(VALUES("SCH",1,0)),U)
+8 SET SIG=SIG_" "_$PIECE($GET(VALUES("SCH",1,0)),U,2)
End DoDot:1
+9 IF SUB="IV"
Begin DoDot:1
+10 SET SIG=" Give: "_$GET(VALUES("DO"))
+11 SET SIG=SIG_" "_$$EXT^ORWGAPIX($GET(VALUES("START")),55.01,.02)
+12 SET SIG=SIG_" "_$GET(VALUES("SCH",1,0))
End DoDot:1
+13 QUIT SIG
+14 ;
LAB(ORVALUE,NODE,ITEM) ; from ORWGAPI3
+1 DO LRPXRM^LRPXAPI(.ORVALUE,NODE,ITEM,"VSC")
+2 QUIT
+3 ;
LABNAME(Y) ; $$(item ien) -> item name
+1 IF $PIECE(Y,";")="A"
IF $PIECE(Y,";",2)="S"
QUIT $PIECE(Y,".",2,99)
+2 QUIT $$ITEMNM^LRPXAPIU(Y)
+3 ;
LABSUM(ORDATA,DFN,DATE1,DATE2,ORSUB) ; from ORWGAPID
+1 DO EN^LR7OSUM(.ORDATA,DFN,DATE1,DATE2,,80,.ORSUB)
+2 QUIT
+3 ;
LRDFN(DFN) ; $$(dfn) -> lrdfn
+1 QUIT $$LRDFN^LRPXAPIU(DFN)
+2 ;
LRIDT(LRDT) ; $$(date) -> inverse date
+1 QUIT $$LRIDT^LRPXAPIU(LRDT)
+2 ;
NVASIG(NODE) ; $$(node) -> sig on non-va drug
+1 NEW RESULTS,SIG
KILL RESULTS
+2 IF '$LENGTH(NODE)
QUIT ""
+3 DO RXNVA(NODE,.RESULTS)
+4 SET SIG=RESULTS("DOSAGE")
+5 SET SIG=SIG_" "_RESULTS("MEDICATION ROUTE")
+6 SET SIG=SIG_" "_RESULTS("SCHEDULE")
+7 QUIT SIG
+8 ;
NVAX(DFN) ; $$(dfn) -> 1 if patient has data else 0
+1 QUIT $LENGTH($ORDER(^PXRMINDX("55NVA","PI",+$GET(DFN),"")))>0
+2 ;
POINAME(IEN) ; $$(poi entry) - > name and dosage form else ""
+1 NEW NAME,RESULT
KILL ^TMP($JOB,"RX")
+2 IF '$GET(IEN)
QUIT ""
+3 DO ZERO^PSS50P7(IEN,,,"RX")
+4 SET NAME=$PIECE($GET(^TMP($JOB,"RX",IEN,.01)),U)
+5 KILL ^TMP($JOB,"RX")
+6 IF NAME'=" "
QUIT NAME
+7 QUIT ""
+8 ;
RXIN(NODE,ORVALUE) ; from ORWGAPI3
+1 DO OEL^PSJPXRM1(NODE,.ORVALUE)
+2 QUIT
+3 ;
RXNUM(DFN,RXIEN) ; $$(dfn,prescription ien) -> rx#
+1 NEW RXNUM
KILL ^TMP($JOB,"RX")
+2 SET RXIEN=+$GET(RXIEN)
+3 DO RX^PSO52API(DFN,"RX",RXIEN,,0)
+4 SET RXNUM=$GET(^TMP($JOB,"RX",DFN,RXIEN,.01))
+5 IF $LENGTH(RXNUM)
SET RXNUM=" RX#: "_+RXNUM
+6 KILL ^TMP($JOB,"RX")
+7 QUIT RXNUM
+8 ;
RXNVA(NODE,ORVALUE,XSTART,XSTOP) ; from ORWGAPI1, ORWGAPI3, ORWGAPID
+1 SET XSTART=1
SET XSTOP=1
+2 DO NVA^PSOPXRM1(NODE,.ORVALUE)
+3 IF '$GET(ORVALUE("START DATE"))
Begin DoDot:1
+4 SET ORVALUE("START DATE")=$GET(ORVALUE("DOCUMENTED DATE"))
+5 SET XSTART=0
End DoDot:1
+6 IF '$GET(ORVALUE("DISCONTINUED DATE"))
Begin DoDot:1
+7 SET XSTOP=0
End DoDot:1
+8 QUIT
+9 ;
RXOUT(NODE,ORVALUE) ; from ORWGAPI3
+1 DO PSRX^PSOPXRM1(NODE,.ORVALUE)
+2 QUIT
+3 ;
SIG(DFN,RXIEN) ; $$(dfn,prescription ien) -> sig
+1 NEW LNUM,SIG
KILL ^TMP($JOB,"RX")
+2 SET RXIEN=+$GET(RXIEN)
+3 DO RX^PSO52API(DFN,"RX",RXIEN,,"M",,)
+4 SET SIG=""
+5 SET LNUM=0
+6 FOR
SET LNUM=$ORDER(^TMP($JOB,"RX",DFN,RXIEN,"M",LNUM))
if LNUM<1
QUIT
Begin DoDot:1
+7 SET SIG=SIG_$GET(^TMP($JOB,"RX",DFN,RXIEN,"M",LNUM,0))_" "
End DoDot:1
+8 IF $LENGTH(SIG)
SET SIG=" Sig: "_$$LOW^ORWGAPIX(SIG)
+9 KILL ^TMP($JOB,"RX")
+10 QUIT SIG
+11 ;
SOLDRUG(IEN) ; $$(iv solution) -> drug in 50 else ""
+1 NEW RESULT
KILL ^TMP($JOB,"RX")
+2 IF '$GET(IEN)
QUIT ""
+3 DO ZERO^PSS52P7(IEN,,,"RX")
+4 SET RESULT=$PIECE($GET(^TMP($JOB,"RX",IEN,1)),U)
+5 KILL ^TMP($JOB,"RX")
+6 QUIT RESULT
+7 ;
TESTSPEC(DATA) ; from ORWGAPI
+1 NEW CNT,LINE,TEST,TMP,SPEC
+2 DO RETURN^ORWGAPIW(.TMP,.DATA)
+3 SET CNT=0
+4 SET TEST=0
+5 FOR
SET TEST=$ORDER(^LAB(60,TEST))
if TEST<1
QUIT
Begin DoDot:1
+6 SET SPEC=0
+7 FOR
SET SPEC=$ORDER(^LAB(60,TEST,1,SPEC))
if SPEC<1
QUIT
Begin DoDot:2
+8 SET CNT=CNT+1
+9 SET LINE=TEST_U_$GET(^LAB(60,TEST,1,SPEC,0))
+10 IF $PIECE(LINE,U,3)[$CHAR(34)
SET $PIECE(LINE,U,3)=$$TRIM^ORWGAPIX($PIECE(LINE,U,3),"LR",$CHAR(34))
+11 IF $PIECE(LINE,U,4)[$CHAR(34)
SET $PIECE(LINE,U,4)=$$TRIM^ORWGAPIX($PIECE(LINE,U,4),"LR",$CHAR(34))
+12 IF TMP
SET ^TMP(DATA,$JOB,CNT)=LINE
QUIT
+13 SET DATA(CNT)=LINE
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
