ORWGAPIA ; SLC/STAFF - Graph Application Calls ;07/16/13 13:20
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,251,260,243,372,361**;Dec 17, 1997;Build 39
;
; External References:
; $$ICDDATA^ICDXCODE ICR #5699
; $$CPT^ICPTCOD ICR #1995
; $$DOCCLASS^TIULC1 ICR #3548
; $$HASDOCMT^TIULX ICR #4315
; $$ISA^USRLM ICR #1544
;
ADMITX(DFN) ; $$(dfn) -> 1 if patient has data else 0
Q $O(^DGPM("C",+$G(DFN),0))>0
;
ALLERGYX(DFN) ; $$(dfn) -> 1 if patient has data else 0
Q $O(^GMR(120.8,"B",+$G(DFN),0))>0
;
ALLG(IEN) ; $$(ien) -> external display of allergies
I IEN Q $P($G(^GMRD(120.83,IEN,0)),U) ; this is for rxn, allergy is free text
Q IEN
;
CPT(NODE,ORVALUE,VALUES) ; from ORWGAPI4
D VCPT^PXPXRM(NODE,.ORVALUE)
S VALUES=$$DATA^ORWGAPIW(.ORVALUE) ;*****************************
Q
;
DISCH(IEN) ; $$(pt movement ien) -> discharge date
Q $P($G(^DGPM(+$P($G(^DGPM(+$G(IEN),0)),U,17),0)),U)
;
DOCCLASS(DOCTYPE) ; $$(doc type) -> ien of tiu doc class
N CONSULTS
S DOCTYPE=$E(DOCTYPE,1)
I DOCTYPE="P" Q 3
I DOCTYPE="D" Q 244
I DOCTYPE="C" D CNSLCLAS^TIUSRVD(.CONSULTS) Q CONSULTS
Q 0
;
EDU(NODE,ORVALUE,VALUES) ; from ORWGAPI4
D VPEDU^PXPXRM(NODE,.ORVALUE)
S VALUES=$$DATA^ORWGAPIW(.ORVALUE) ;*****************************
Q
;
EXAM(NODE,ORVALUE,VALUES) ; from ORWGAPI4
D VXAM^PXPXRM(NODE,.ORVALUE)
S VALUES=$$DATA^ORWGAPIW(.ORVALUE) ;*****************************
Q
;
GETTIU(ORDATA,IEN) ; from ORWGAPID
D TGET^TIUSRVR1(.ORDATA,IEN)
Q
;
HF(NODE,ORVALUE,VALUES) ; from ORWGAPI4
D VHF^PXPXRM(NODE,.ORVALUE)
S VALUES=$$DATA^ORWGAPIW(.ORVALUE) ;*****************************
Q
;
ICD0(IEN) ; $$(ien) -> external display of IDC0
N INFO
S INFO=$$ICDDATA^ICDXCODE("PROCEDURE",IEN,DT)
I INFO<0 Q ""
Q $P(INFO,U,2)_" "_$P(INFO,U,5)
;
ICD9(IEN) ; $$(ien) -> external display of IDC9
N INFO
S INFO=$$ICDDATA^ICDXCODE("DIAGNOSIS",IEN,DT)
I INFO<0 Q ""
Q $P(INFO,U,2)_" "_$P(INFO,U,4)
;
ICPT(IEN,CSD) ; $$(ien) -> external display of CPT
N X S X=$$CPT^ICPTCOD($G(IEN),$G(CSD))
Q $P(X,U,2)_" "_$E($P(X,U,3),1,30)
;
IMM(NODE,ORVALUE,VALUES) ; from ORWGAPI4
D VIMM^PXPXRM(NODE,.ORVALUE)
S VALUES=$$DATA^ORWGAPIW(.ORVALUE) ;*****************************
Q
;
ISA(USER,CLASS,ORERR) ; $$(user,user class,err) -> 1 if user in class, else 0
Q $$ISA^USRLM(USER,CLASS,.ORERR)
;
LOS(DGPMIFN) ; $$(pt movement ien) -> length of stay
N X D ^DGPMLOS
Q +$P($G(X),U,5)
;
MEDICINE(ARRAY,DFN) ;
N DATE,FILE,IEN,NAME,NUM,REF,VALUES,XREF
K ARRAY,^TMP("MCAR",$J),^TMP("OR",$J,"MCAR")
D FILE^ORWGAPIU(690,.REF,.XREF)
I '$L(REF) Q
I $E(REF,$L(REF))="," S REF=$E(REF,1,$L(REF)-1)_")"
I $E(REF,$L(REF))="(" S REF=$P(REF,"(")
D EN^MCARPS2(DFN)
S NUM=0
F S NUM=$O(^TMP("OR",$J,"MCAR","OT",NUM)) Q:NUM<1 D
. S VALUES=^TMP("OR",$J,"MCAR","OT",NUM)
. S DATE=$$DATETFM^ORWGAPIW($P(VALUES,U,6))
. S NAME=$P(VALUES,U) I '$L(NAME) Q
. S IEN=+$O(@REF@(XREF,NAME,""))
. I DATE,IEN S ARRAY(IEN,DATE)=NAME
K ^TMP("MCAR",$J),^TMP("OR",$J,"MCAR")
Q
;
MEDVAL(VAL) ;
N IEN,NAME,NAMES,REF,SEQ,XREF K NAMES,VAL
D FILE^ORWGAPIU(690,.REF,.XREF)
I '$L(REF) Q
I $E(REF,$L(REF))="," S REF=$E(REF,1,$L(REF)-1)_")"
I $E(REF,$L(REF))="(" S REF=$P(REF,"(")
S NAME=""
F S NAME=$O(@REF@(XREF,NAME)) Q:NAME="" D
. S IEN=0
. F S IEN=$O(@REF@(XREF,NAME,IEN)) Q:IEN<1 D
.. S NAMES(IEN)=NAME
S SEQ=0
S IEN=0
F S IEN=$O(NAMES(IEN)) Q:IEN<1 D
. S SEQ=SEQ+1
. S VAL(SEQ)=690_U_IEN_U_NAMES(IEN)
Q
;
MH(ORVALUE,NODE,VALUES) ; from ORWGAPI4
D ENDAS^YTAPI10(.ORVALUE,NODE)
S VALUES=$$DATA^ORWGAPIW(.ORVALUE) ;*****************************
Q
;
NOTEX(DFN) ; $$(dfn) -> 1 if patient has data else 0
Q $$HASDOCMT^TIULX($G(DFN))
;
OITEM(DATA) ; API - get order display groups - from ORWGAPI
N CNT,IEN,RESULT,TMP,ZERO
D RETURN^ORWGAPIW(.TMP,.DATA)
S CNT=0
S IEN=0
F S IEN=$O(^ORD(100.98,IEN)) Q:IEN<1 D
. S ZERO=$G(^ORD(100.98,IEN,0)) I '$L(ZERO) Q
. S RESULT="100.98^"_IEN_U_$P(ZERO,U)_U_$P(ZERO,U,3)
. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
POV(NODE,ORVALUE,VALUES) ; from ORWGAPI4
D VPOV^PXPXRM(NODE,.ORVALUE)
S VALUES=$$DATA^ORWGAPIW(.ORVALUE) ;*****************************
Q
;
PROB(GMPLLEX,GMPLSTAT,GMPLICD,GMPLODAT,GMPLXDAT,NODE) ; from ORWGAPI4
N GMPLPNAM,GMPLDLM,GMPLTXT,GMPLCOND,GMPLPRV,GMPLPRIO
D CALL2^GMPLUTL3(NODE)
Q
;
PTF(NODE,ORVALUE,VALUES) ; from ORWGAPI3, ORWGAPI4
D PTF^DGPTPXRM(NODE,.ORVALUE)
S VALUES=$$DATA^ORWGAPIW(.ORVALUE) ;*****************************
Q
;
RAD(NODE,ORVALUE,VALUES) ; from ORWGAPI3
D EN1^RAPXRM(NODE,.ORVALUE)
S VALUES=$$DATA^ORWGAPIW(.ORVALUE) ;*****************************
Q
;
SKIN(NODE,ORVALUE,VALUES) ; from ORWGAPI4
D VSKIN^PXPXRM(NODE,.ORVALUE)
S VALUES=$$DATA^ORWGAPIW(.ORVALUE) ;*****************************
Q
;
SURG(ORSURG,DFN,VALUES) ; from ORWGAPI2, ORWGAPI4
D GET^SROGTSR(.ORSURG,DFN)
S VALUES=$$DATA^ORWGAPIW(.ORSURG) ;*****************************
Q
;
SURGX(DFN) ; $$(dfn) -> 1 if patient has data else 0
Q $O(^SRF("B",+$G(DFN),0))>0
;
TAX(IEN) ; $$(ien) -> external display of reminder taxonomy
Q $P($G(^PXD(811.2,+$G(IEN),0)),U)
;
TITLE(DOCTYPE) ; $$(document type) -> parent ien^parent^parent abbrev
N IEN,RESULTS K RESULTS
S DOCTYPE=+$G(^TIU(8925,+$G(DOCTYPE),0))
S IEN=+$$DOCCLASS^TIULC1(DOCTYPE) I 'IEN Q ""
D GETDATA^ORWGAPIX(.RESULTS,8925.1,".01;.02",IEN)
I '$L($G(RESULTS(.01))) Q ""
Q IEN_U_"note - "_RESULTS(.01)_U_$G(RESULTS(.02))
;
TIU(ORVALUE,DOCIEN,ONE,DFN,OLDEST,NEWEST) ; from ORWGAPI1, ORWGAPI3
D CONTEXT^TIUSRVLO(.ORVALUE,DOCIEN,ONE,DFN,$G(OLDEST),$G(NEWEST))
Q
;
TIUTITLE(DATA) ; API - get tiu document titles - from ORWGAPI
N CNT,IEN,RESULT,RESULTS,TMP K ^TMP("TIUTLS",$J)
D RETURN^ORWGAPIW(.TMP,.DATA)
S CNT=0
D TITLIENS^TIULX
S IEN=0
F S IEN=$O(^TMP("TIUTLS",$J,IEN)) Q:IEN<1 D
. K RESULTS
. D GETDATA^ORWGAPIX(.RESULTS,8925.1,".01;.02",IEN)
. I '$L($G(RESULTS(.01))) Q
. S RESULT="8925.1^"_IEN_U_RESULTS(.01)_U_$G(RESULTS(.02))
. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
K ^TMP("TIUTLS",$J)
Q
;
VISITX(DFN) ; $$(dfn) -> 1 if patient has data else 0
Q $O(^AUPNVSIT("AET",+$G(DFN),0))>0
;
VITAL(ORVALUE,NODE,VALUES) ; from ORWGAPI4
D EN^GMVPXRM(.ORVALUE,NODE)
S VALUES=$$DATA^ORWGAPIW(.ORVALUE) ;*****************************
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWGAPIA 6458 printed Dec 13, 2024@02:36:19 Page 2
ORWGAPIA ; SLC/STAFF - Graph Application Calls ;07/16/13 13:20
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,251,260,243,372,361**;Dec 17, 1997;Build 39
+2 ;
+3 ; External References:
+4 ; $$ICDDATA^ICDXCODE ICR #5699
+5 ; $$CPT^ICPTCOD ICR #1995
+6 ; $$DOCCLASS^TIULC1 ICR #3548
+7 ; $$HASDOCMT^TIULX ICR #4315
+8 ; $$ISA^USRLM ICR #1544
+9 ;
ADMITX(DFN) ; $$(dfn) -> 1 if patient has data else 0
+1 QUIT $ORDER(^DGPM("C",+$GET(DFN),0))>0
+2 ;
ALLERGYX(DFN) ; $$(dfn) -> 1 if patient has data else 0
+1 QUIT $ORDER(^GMR(120.8,"B",+$GET(DFN),0))>0
+2 ;
ALLG(IEN) ; $$(ien) -> external display of allergies
+1 ; this is for rxn, allergy is free text
IF IEN
QUIT $PIECE($GET(^GMRD(120.83,IEN,0)),U)
+2 QUIT IEN
+3 ;
CPT(NODE,ORVALUE,VALUES) ; from ORWGAPI4
+1 DO VCPT^PXPXRM(NODE,.ORVALUE)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORVALUE)
+3 QUIT
+4 ;
DISCH(IEN) ; $$(pt movement ien) -> discharge date
+1 QUIT $PIECE($GET(^DGPM(+$PIECE($GET(^DGPM(+$GET(IEN),0)),U,17),0)),U)
+2 ;
DOCCLASS(DOCTYPE) ; $$(doc type) -> ien of tiu doc class
+1 NEW CONSULTS
+2 SET DOCTYPE=$EXTRACT(DOCTYPE,1)
+3 IF DOCTYPE="P"
QUIT 3
+4 IF DOCTYPE="D"
QUIT 244
+5 IF DOCTYPE="C"
DO CNSLCLAS^TIUSRVD(.CONSULTS)
QUIT CONSULTS
+6 QUIT 0
+7 ;
EDU(NODE,ORVALUE,VALUES) ; from ORWGAPI4
+1 DO VPEDU^PXPXRM(NODE,.ORVALUE)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORVALUE)
+3 QUIT
+4 ;
EXAM(NODE,ORVALUE,VALUES) ; from ORWGAPI4
+1 DO VXAM^PXPXRM(NODE,.ORVALUE)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORVALUE)
+3 QUIT
+4 ;
GETTIU(ORDATA,IEN) ; from ORWGAPID
+1 DO TGET^TIUSRVR1(.ORDATA,IEN)
+2 QUIT
+3 ;
HF(NODE,ORVALUE,VALUES) ; from ORWGAPI4
+1 DO VHF^PXPXRM(NODE,.ORVALUE)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORVALUE)
+3 QUIT
+4 ;
ICD0(IEN) ; $$(ien) -> external display of IDC0
+1 NEW INFO
+2 SET INFO=$$ICDDATA^ICDXCODE("PROCEDURE",IEN,DT)
+3 IF INFO<0
QUIT ""
+4 QUIT $PIECE(INFO,U,2)_" "_$PIECE(INFO,U,5)
+5 ;
ICD9(IEN) ; $$(ien) -> external display of IDC9
+1 NEW INFO
+2 SET INFO=$$ICDDATA^ICDXCODE("DIAGNOSIS",IEN,DT)
+3 IF INFO<0
QUIT ""
+4 QUIT $PIECE(INFO,U,2)_" "_$PIECE(INFO,U,4)
+5 ;
ICPT(IEN,CSD) ; $$(ien) -> external display of CPT
+1 NEW X
SET X=$$CPT^ICPTCOD($GET(IEN),$GET(CSD))
+2 QUIT $PIECE(X,U,2)_" "_$EXTRACT($PIECE(X,U,3),1,30)
+3 ;
IMM(NODE,ORVALUE,VALUES) ; from ORWGAPI4
+1 DO VIMM^PXPXRM(NODE,.ORVALUE)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORVALUE)
+3 QUIT
+4 ;
ISA(USER,CLASS,ORERR) ; $$(user,user class,err) -> 1 if user in class, else 0
+1 QUIT $$ISA^USRLM(USER,CLASS,.ORERR)
+2 ;
LOS(DGPMIFN) ; $$(pt movement ien) -> length of stay
+1 NEW X
DO ^DGPMLOS
+2 QUIT +$PIECE($GET(X),U,5)
+3 ;
MEDICINE(ARRAY,DFN) ;
+1 NEW DATE,FILE,IEN,NAME,NUM,REF,VALUES,XREF
+2 KILL ARRAY,^TMP("MCAR",$JOB),^TMP("OR",$JOB,"MCAR")
+3 DO FILE^ORWGAPIU(690,.REF,.XREF)
+4 IF '$LENGTH(REF)
QUIT
+5 IF $EXTRACT(REF,$LENGTH(REF))=","
SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)_")"
+6 IF $EXTRACT(REF,$LENGTH(REF))="("
SET REF=$PIECE(REF,"(")
+7 DO EN^MCARPS2(DFN)
+8 SET NUM=0
+9 FOR
SET NUM=$ORDER(^TMP("OR",$JOB,"MCAR","OT",NUM))
if NUM<1
QUIT
Begin DoDot:1
+10 SET VALUES=^TMP("OR",$JOB,"MCAR","OT",NUM)
+11 SET DATE=$$DATETFM^ORWGAPIW($PIECE(VALUES,U,6))
+12 SET NAME=$PIECE(VALUES,U)
IF '$LENGTH(NAME)
QUIT
+13 SET IEN=+$ORDER(@REF@(XREF,NAME,""))
+14 IF DATE
IF IEN
SET ARRAY(IEN,DATE)=NAME
End DoDot:1
+15 KILL ^TMP("MCAR",$JOB),^TMP("OR",$JOB,"MCAR")
+16 QUIT
+17 ;
MEDVAL(VAL) ;
+1 NEW IEN,NAME,NAMES,REF,SEQ,XREF
KILL NAMES,VAL
+2 DO FILE^ORWGAPIU(690,.REF,.XREF)
+3 IF '$LENGTH(REF)
QUIT
+4 IF $EXTRACT(REF,$LENGTH(REF))=","
SET REF=$EXTRACT(REF,1,$LENGTH(REF)-1)_")"
+5 IF $EXTRACT(REF,$LENGTH(REF))="("
SET REF=$PIECE(REF,"(")
+6 SET NAME=""
+7 FOR
SET NAME=$ORDER(@REF@(XREF,NAME))
if NAME=""
QUIT
Begin DoDot:1
+8 SET IEN=0
+9 FOR
SET IEN=$ORDER(@REF@(XREF,NAME,IEN))
if IEN<1
QUIT
Begin DoDot:2
+10 SET NAMES(IEN)=NAME
End DoDot:2
End DoDot:1
+11 SET SEQ=0
+12 SET IEN=0
+13 FOR
SET IEN=$ORDER(NAMES(IEN))
if IEN<1
QUIT
Begin DoDot:1
+14 SET SEQ=SEQ+1
+15 SET VAL(SEQ)=690_U_IEN_U_NAMES(IEN)
End DoDot:1
+16 QUIT
+17 ;
MH(ORVALUE,NODE,VALUES) ; from ORWGAPI4
+1 DO ENDAS^YTAPI10(.ORVALUE,NODE)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORVALUE)
+3 QUIT
+4 ;
NOTEX(DFN) ; $$(dfn) -> 1 if patient has data else 0
+1 QUIT $$HASDOCMT^TIULX($GET(DFN))
+2 ;
OITEM(DATA) ; API - get order display groups - from ORWGAPI
+1 NEW CNT,IEN,RESULT,TMP,ZERO
+2 DO RETURN^ORWGAPIW(.TMP,.DATA)
+3 SET CNT=0
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^ORD(100.98,IEN))
if IEN<1
QUIT
Begin DoDot:1
+6 SET ZERO=$GET(^ORD(100.98,IEN,0))
IF '$LENGTH(ZERO)
QUIT
+7 SET RESULT="100.98^"_IEN_U_$PIECE(ZERO,U)_U_$PIECE(ZERO,U,3)
+8 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:1
+9 QUIT
+10 ;
POV(NODE,ORVALUE,VALUES) ; from ORWGAPI4
+1 DO VPOV^PXPXRM(NODE,.ORVALUE)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORVALUE)
+3 QUIT
+4 ;
PROB(GMPLLEX,GMPLSTAT,GMPLICD,GMPLODAT,GMPLXDAT,NODE) ; from ORWGAPI4
+1 NEW GMPLPNAM,GMPLDLM,GMPLTXT,GMPLCOND,GMPLPRV,GMPLPRIO
+2 DO CALL2^GMPLUTL3(NODE)
+3 QUIT
+4 ;
PTF(NODE,ORVALUE,VALUES) ; from ORWGAPI3, ORWGAPI4
+1 DO PTF^DGPTPXRM(NODE,.ORVALUE)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORVALUE)
+3 QUIT
+4 ;
RAD(NODE,ORVALUE,VALUES) ; from ORWGAPI3
+1 DO EN1^RAPXRM(NODE,.ORVALUE)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORVALUE)
+3 QUIT
+4 ;
SKIN(NODE,ORVALUE,VALUES) ; from ORWGAPI4
+1 DO VSKIN^PXPXRM(NODE,.ORVALUE)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORVALUE)
+3 QUIT
+4 ;
SURG(ORSURG,DFN,VALUES) ; from ORWGAPI2, ORWGAPI4
+1 DO GET^SROGTSR(.ORSURG,DFN)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORSURG)
+3 QUIT
+4 ;
SURGX(DFN) ; $$(dfn) -> 1 if patient has data else 0
+1 QUIT $ORDER(^SRF("B",+$GET(DFN),0))>0
+2 ;
TAX(IEN) ; $$(ien) -> external display of reminder taxonomy
+1 QUIT $PIECE($GET(^PXD(811.2,+$GET(IEN),0)),U)
+2 ;
TITLE(DOCTYPE) ; $$(document type) -> parent ien^parent^parent abbrev
+1 NEW IEN,RESULTS
KILL RESULTS
+2 SET DOCTYPE=+$GET(^TIU(8925,+$GET(DOCTYPE),0))
+3 SET IEN=+$$DOCCLASS^TIULC1(DOCTYPE)
IF 'IEN
QUIT ""
+4 DO GETDATA^ORWGAPIX(.RESULTS,8925.1,".01;.02",IEN)
+5 IF '$LENGTH($GET(RESULTS(.01)))
QUIT ""
+6 QUIT IEN_U_"note - "_RESULTS(.01)_U_$GET(RESULTS(.02))
+7 ;
TIU(ORVALUE,DOCIEN,ONE,DFN,OLDEST,NEWEST) ; from ORWGAPI1, ORWGAPI3
+1 DO CONTEXT^TIUSRVLO(.ORVALUE,DOCIEN,ONE,DFN,$GET(OLDEST),$GET(NEWEST))
+2 QUIT
+3 ;
TIUTITLE(DATA) ; API - get tiu document titles - from ORWGAPI
+1 NEW CNT,IEN,RESULT,RESULTS,TMP
KILL ^TMP("TIUTLS",$JOB)
+2 DO RETURN^ORWGAPIW(.TMP,.DATA)
+3 SET CNT=0
+4 DO TITLIENS^TIULX
+5 SET IEN=0
+6 FOR
SET IEN=$ORDER(^TMP("TIUTLS",$JOB,IEN))
if IEN<1
QUIT
Begin DoDot:1
+7 KILL RESULTS
+8 DO GETDATA^ORWGAPIX(.RESULTS,8925.1,".01;.02",IEN)
+9 IF '$LENGTH($GET(RESULTS(.01)))
QUIT
+10 SET RESULT="8925.1^"_IEN_U_RESULTS(.01)_U_$GET(RESULTS(.02))
+11 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:1
+12 KILL ^TMP("TIUTLS",$JOB)
+13 QUIT
+14 ;
VISITX(DFN) ; $$(dfn) -> 1 if patient has data else 0
+1 QUIT $ORDER(^AUPNVSIT("AET",+$GET(DFN),0))>0
+2 ;
VITAL(ORVALUE,NODE,VALUES) ; from ORWGAPI4
+1 DO EN^GMVPXRM(.ORVALUE,NODE)
+2 ;*****************************
SET VALUES=$$DATA^ORWGAPIW(.ORVALUE)
+3 QUIT
+4 ;
