Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWPCE

ORWPCE.m

Go to the documentation of this file.
  1. ORWPCE ; SLC/JM/REV - wrap calls to PCE and AICS ;Aug 28, 2023@15:52
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,173,190,195,215,243,295,280,306,361,385,398,377,476,539,405,588,606**;Dec 17, 1997;Build 3
  1. ;
  1. ; Reference to LOOK^LEXA, ^TMP("LEXFND",$J) in ICR #2950
  1. ; Reference to CONFIG^LEXSET, ^TMP("LEXSCH",$J) in ICR #1609
  1. ; Reference to DSELECT^GMPLENFM, ^TMP("IB",$J) in ICR #1365
  1. ; Reference to VLTD^ICDEX in ICR #5747
  1. ; Reference to CODEBA^ICDEX in ICR #5747
  1. ; Reference to GETLST^IBDF18A in ICR #1296
  1. ; Reference to $$ICDDESC^ICDXCODE in ICR #5699
  1. ; Reference to GETFIELD^PXAAVSIT in ICR #3048
  1. ; Reference to VSTRBLD^TIUSRVP in ICR #4075
  1. ; Reference to DOCCNT^TIUSRVLV in ICR #2812
  1. ; Reference to $$ISADDNDM^TIULC1 in ICR #2323
  1. ; Reference to SCCOND^PXUTLSCC in ICR #2348
  1. ; Reference to PRENDIAG^PXRMPDX in ICR #6991
  1. ; Reference to SVC^PXKCO in ICR #3225
  1. ; Reference to ENCEVENT^PXAPI in ICR #1894
  1. ; Reference to VST2APPT^PXAPI in ICR #1895
  1. ; Reference to $$GETENC^PXAPI in ICR #1894
  1. ; Reference to DELVFILE^PXAPI in ICR #1890
  1. ; Reference to ^TIU(8925, in ICR #2937
  1. ; Reference to ^DIC(31, in ICR #2967
  1. ; Reference to ^DG(391, in ICR #2966
  1. ;
  1. Q
  1. VISIT(LST,CLINIC,ORDATE) ; get list of visit types for clinic
  1. S:'+$G(ORDATE) ORDATE=DT
  1. D GETLST^IBDF18A(CLINIC,"DG SELECT VISIT TYPE CPT PROCEDURES","LST",,,,ORDATE)
  1. Q
  1. PROC(LST,CLINIC,ORDATE) ; get list of procedures for clinic P12 for CPTMods
  1. S:'+$G(ORDATE) ORDATE=DT
  1. D GETLST^IBDF18A(CLINIC,"DG SELECT CPT PROCEDURE CODES","LST",,,1,ORDATE)
  1. N IDX,MOD,CODES,FIRST S IDX=0
  1. F S IDX=$O(LST(IDX)) Q:'+IDX D
  1. . I LST(IDX)="" K LST(IDX) Q
  1. . S MOD=0,CODES="",FIRST=1
  1. . F S MOD=$O(LST(IDX,"MODIFIER",MOD)) Q:(MOD="") D
  1. . . I FIRST S FIRST=0
  1. . . E S CODES=CODES_";"
  1. . . S CODES=CODES_LST(IDX,"MODIFIER",MOD)
  1. . K LST(IDX,"MODIFIER")
  1. . I 'FIRST S $P(LST(IDX),U,12)=CODES
  1. Q
  1. CPTMODS(LST,ORCPTCOD,ORDATE) ;Return CPT Modifiers for a CPT Code
  1. N ORM,ORIDX,ORI,MODNAME
  1. S:'+$G(ORDATE) ORDATE=DT
  1. I +($$CODM^ICPTCOD(ORCPTCOD,$NA(ORM),0,ORDATE)),+$D(ORM) D
  1. . S ORIDX="",ORI=0
  1. . F S ORIDX=$O(ORM(ORIDX)) Q:(ORIDX="") D
  1. . . S ORI=ORI+1,MODNAME=$P(ORM(ORIDX),U,1)
  1. . . S LST(MODNAME_ORI)=$P(ORM(ORIDX),U,2)_U_MODNAME_U_ORIDX
  1. Q
  1. GETMOD(MODINFO,ORMODIEN,ORDATE) ;Returns info for a specific CPT Modifier
  1. N ORDATA
  1. S:'+$G(ORDATE) ORDATE=DT
  1. S ORDATA=$$MOD^ICPTMOD(ORMODIEN,"I",ORDATE,1)
  1. I +ORDATA>0 S MODINFO=ORMODIEN_U_$P(ORDATA,U,3)_U_$P(ORDATA,U,2)
  1. Q
  1. DIAG(LIST,CLINIC,ORDATE,ORDFN) ; get list of diagnoses for clinic AND prior encounter diagnoses if ORDFN passed
  1. S:'+$G(ORDATE) ORDATE=DT
  1. ; *498 ajb merge lists if needed from prior encounter and clinics
  1. N LST,ORCNT,CODE,CODEIEN,DATE,J,VISITIEN ; some variables left over by call below, cleaning up with *498
  1. ; LIST(0)=total # of entries returned by both calls
  1. I +$G(ORDFN) D ; only get prior encounter diagnoses if ORDRN is passed in
  1. . S LIST(0)=$$PRENDIAG^PXRMPDX(ORDFN,"T-3Y",ORDATE,.LIST) I '+LIST(0) S LIST(0)=1
  1. . S LIST(1)=$$TITLE^XLFSTR(LIST(1))_" [Past 3 Years]"
  1. D GETLST^IBDF18A(CLINIC,"DG SELECT ICD DIAGNOSIS CODES","LST",,,,ORDATE)
  1. S ORCNT=0 F S ORCNT=$O(LST(ORCNT)) Q:'+ORCNT D
  1. . S LIST(0)=$G(LIST(0))+1
  1. . I $P(LST(ORCNT),U)]"" S $P(LST(ORCNT),U,10)=$$VLTD^ICDEX($$CODEBA^ICDEX($P(LST(ORCNT),U),80),DT)
  1. . S LIST(LIST(0))=LST(ORCNT)
  1. S LIST(0)=$O(LIST(""),-1) ; set to total amount
  1. Q
  1. IMM(LST,CLINIC) ;get list of immunizations for clinic
  1. D GETLST^IBDF18A(CLINIC,"PX SELECT IMMUNIZATIONS","LST")
  1. Q
  1. SK(LST,CLINIC) ;get list of skin test for clinic
  1. D GETLST^IBDF18A(CLINIC,"PX SELECT SKIN TESTS","LST")
  1. Q
  1. HF(LST,CLINIC) ;get list of health factors for clinic
  1. D GETLST^IBDF18A(CLINIC,"PX SELECT HEALTH FACTORS","LST")
  1. Q
  1. PED(LST,CLINIC) ;get list of education topices for clinic
  1. D GETLST^IBDF18A(CLINIC,"PX SELECT EDUCATION TOPICS","LST")
  1. Q
  1. TRT(LST,CLINIC) ;get list of treatments for clinic
  1. D GETLST^IBDF18A(CLINIC,"PX SELECT TREATMENTS","LST")
  1. Q
  1. XAM(LST,CLINIC) ;get list of exams for clinic
  1. D GETLST^IBDF18A(CLINIC,"PX SELECT EXAMS","LST")
  1. Q
  1. ACTPROB(GLST,DFN,ORDATE) ;get list of patient's active problems
  1. N ORPROB,ORPROBIX,ORPRCNT,ORTXT,ORTXT1,ORCODSYS,ORCOD,ORDT,ORTRY,QTLTXT,SCD,ORDATA,GMPINDT,DIAGINC,ORIMPDT
  1. K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
  1. S:'+$G(ORDATE) ORDATE=DT
  1. S GMPINDT=ORDATE,ORIMPDT=$$IMPDATE^LEXU("10D")
  1. D DSELECT^GMPLENFM ;DBIA 1365
  1. S ORPRCNT=0
  1. S ORPROBIX=0
  1. F S ORPROBIX=$O(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX)) Q:'ORPROBIX D ;DBIA 1365
  1. . I (ORDATE<ORIMPDT)&($P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",14)="10D") K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX) Q
  1. . S ORPROB=$P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3)
  1. . I $L(ORPROB)>255 S $P(ORPROB,U)=$E($P(ORPROB,U),1,245)
  1. . I $E(ORPROB,1)="$" S ORPROB=$E(ORPROB,2,255)
  1. . I '$D(ORPROB(ORPROB)) D
  1. .. S ORPROB(ORPROB)=""
  1. .. S ORPRCNT=ORPRCNT+1
  1. .. S $P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3)=ORPROB
  1. . E K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX)
  1. S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=ORPRCNT
  1. S GLST=$NA(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS"))
  1. Q
  1. SCSEL(VAL,DFN,ATM,LOC,VST) ; return SC conditions that may be selected
  1. ; VAL=SCallow^SCdflt;AOallow^AOdflt;IRallow^IRdflt;ECallow^ECdflt;
  1. ; MSTallow^MSTdflt;HNCallow^HNCdflt;CVAllow^CVDflt;SHADAllow^SHADDflt
  1. N ORX,S S S=";"
  1. D SCCOND^PXUTLSCC(DFN,ATM,LOC,$G(VST),.ORX)
  1. S VAL=$G(ORX("SC"))_S_$G(ORX("AO"))_S_$G(ORX("IR"))_S_$G(ORX("EC"))_S_$G(ORX("MST"))_S_$G(ORX("HNC"))_S_$G(ORX("CV"))_S_$G(ORX("SHAD"))
  1. Q
  1. SCDIS(LST,DFN) ; Return service connected % and rated disabilities
  1. N VAEL,VAERR,I,ILST,DIS,SC,X
  1. D ELIG^VADPT
  1. S LST(1)="Service Connected: "_$S(+VAEL(3):$P(VAEL(3),U,2)_"%",1:"NO")
  1. I 'VAEL(4),'$P($G(^DG(391,+VAEL(6),0)),U,2) S LST(2)="NOT A VETERAN." Q
  1. S I=0,ILST=1 F S I=$O(^DPT(DFN,.372,I)) Q:'I S X=^(I,0) D
  1. . S DIS=$P($G(^DIC(31,+X,0)),U) Q:DIS=""
  1. . S SC=$S($P(X,U,3):"SC",$P(X,U,3)']"":"not specified",1:"NSC")
  1. . S ILST=ILST+1,LST(ILST)=DIS_" ("_$P(X,U,2)_"% "_SC_")"
  1. I ILST=1 S LST(2)="Rated Disabilities: NONE STATED"
  1. Q
  1. CPTREQD(VAL,IEN) ; return 1 in VAL if note still needs a CPT code
  1. S VAL=+$P(^TIU(8925,IEN,0),U,11)
  1. Q
  1. NOTEVSTR(VAL,IEN) ; return the VSTR^AUTHOR for a note
  1. N ISADD,TIEN,X0,X12,VISIT
  1. S ISADD=+$$ISADDNDM^TIULC1(IEN)
  1. S X0=$G(^TIU(8925,IEN,0))
  1. I ISADD S TIEN=+$P(X0,U,6)
  1. S IEN=+$G(IEN),VAL="" Q:'IEN
  1. S X12=$G(^TIU(8925,IEN,12)),VISIT=+$P(X12,U,7)
  1. I VISIT S VAL=$$VSTRBLD^TIUSRVP(VISIT)
  1. I 'VISIT D
  1. .I ISADD=1,TIEN>0 S IEN=TIEN,X12=$G(^TIU(8925,IEN,12))
  1. .S X0=$G(^TIU(8925,IEN,0)),VAL=$P(X12,U,11)_";"_$P(X0,U,7)_";"_$P(X0,U,13)
  1. .I $P(VAL,";",3)="H" S $P(VAL,";",2)=$P(X12,U),$P(VAL,";",3)="D"
  1. Q
  1. HASVISIT(ORY,IEN,DFN,ORLOC,ORDTE) ;Has visit or is stand alone
  1. N ORVISIT
  1. S ORY=-1
  1. I +$G(IEN)>0 S ORVISIT=+$P($G(^TIU(8925,+IEN,0)),U,3)
  1. I +$G(ORVISIT)'>0 S ORVISIT=$$GETENC^PXAPI(DFN,ORDTE,ORLOC)
  1. I +$G(ORVISIT)>0 S ORY=$$VST2APPT^PXAPI(ORVISIT)
  1. Q
  1. DELETE(VAL,VSTR,DFN,VISIT) ; delete PCE info when deleting a note
  1. ; VSTR = Visit String
  1. ; DFN = Patient IEN (#2)
  1. ; VISIT = Visit IEN (#9000010)
  1. ;
  1. ; Must either pass in VISIT, or must pass in VSTR and DFN.
  1. ; It is best to pass in VISIT. VSTR and DFN are only included for backward compatability.
  1. ;
  1. N ORCOUNT,ORVISITLIST
  1. S VAL=0
  1. I '$G(VISIT),('$G(DFN)!($G(VSTR)="")) Q
  1. ;
  1. ; CPRS can pass VISIT=-1 if the note being deleted did not reference a Visit
  1. I $G(VISIT)<0 Q
  1. ;
  1. I +$G(VISIT)=0 S VISIT=$$GETVSIT^ORWPCE1($G(VSTR),$G(DFN))
  1. I VISIT'>0 Q
  1. ;
  1. I $$GETFIELD^PXAAVSIT(VISIT,.07)="H" Q ; leave inpatient alone
  1. ;
  1. ; Do not delete if another title points to visit
  1. D DOCCNT^TIUSRVLV(.ORCOUNT,"","",VISIT,1)
  1. I ORCOUNT>0 Q
  1. ;
  1. S VAL=$$DELVFILE^PXAPI("ALL",VISIT,"","TEXT INTEGRATION UTILITIES")
  1. Q
  1. SAVE(RESULT,PCELIST,NOTEIEN,ORLOC) ; save PCE information
  1. N VSTR,GMPLUSER,HEADER
  1. N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC,ZTSYNC,ZTSK
  1. S VSTR=$P(PCELIST(1),U,4) K ^TMP("ORWPCE",$J,VSTR)
  1. M ^TMP("ORWPCE",$J,VSTR)=PCELIST
  1. S GMPLUSER=$$CLINUSER^ORQQPL1(DUZ),NOTEIEN=+$G(NOTEIEN)
  1. ;S ZTIO="ORW/PXAPI RESOURCE",ZTRTN="DQSAVE^ORWPCE1",ZTDTH=$H
  1. ;S ZTSAVE("PCELIST(")="",ZTDESC="Data from CPRS to PCE"
  1. ;S ZTSAVE("GMPLUSER")="",ZTSAVE("NOTEIEN")="",ZTSAVE("DUZ")=""
  1. ;I VSTR'["E" S ZTSYNC="ORW"_VSTR
  1. ;S ZTSAVE("ORLOC")=""
  1. ;D ^%ZTLOAD I '$D(ZTSK) D DQSAVE^ORWPCE1
  1. S HEADER="CPRS ERROR SAVING ENCOUNTER DATA"
  1. N $ES,$ET S $ET="D ERRHRLR^ORERRH(1,HEADER)"
  1. D DQSAVE^ORWPCE1(.RESULT,.PCELIST,NOTEIEN,GMPLUSER,ORLOC)
  1. Q
  1. LEX(LST,X,APP,ORDATE) ; return list after lexicon lookup
  1. N LEX,ILST,I,IEN,ORIMPDT
  1. S ORIMPDT=$$IMPDATE^LEXU("10D")
  1. S:APP="CPT" APP="CHP" ; LEX PATCH 10
  1. S:'+$G(ORDATE) ORDATE=DT
  1. I APP="ICD",(ORDATE'<ORIMPDT) S APP="10D"
  1. D CONFIG^LEXSET(APP,APP,ORDATE) ;DBIA 1609
  1. I APP="CHP" D
  1. . ; Set the filter for CPT only using CS APIs - format is the same as for DIC("S")
  1. . S ^TMP("LEXSCH",$J,"FIL",0)="I $L($$CPTONE^LEXU(+Y,$G(ORDATE)))!($L($$CPCONE^LEXU(+Y,$G(ORDATE))))" ;DBIA 1609
  1. . ; Set Applications Default Flag (Lexicon can not overwrite filter)
  1. . S ^TMP("LEXSCH",$J,"ADF",0)=1
  1. D LOOK^LEXA(X,APP,1,"",ORDATE)
  1. I '$D(LEX("LIST",1)) D G LEXX
  1. . S LST(1)="-1^No matches found.^"_APP
  1. S LST(1)=LEX("LIST",1),ILST=1
  1. S (I,IEN)=""
  1. F S I=$O(^TMP("LEXFND",$J,I)) Q:I="" D ;DBIA 2950
  1. .F S IEN=$O(^TMP("LEXFND",$J,I,IEN)) Q:IEN="" D
  1. ..S ILST=ILST+1,LST(ILST)=IEN_U_^TMP("LEXFND",$J,I,IEN)
  1. LEXX K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J),^TMP("LEXSCH",$J),^TMP("LEXLE",$J)
  1. Q
  1. LEXCODE(VAL,IEN,APP,ORDATE) ; return code for a lexicon entry
  1. S VAL=""
  1. S:'+$G(ORDATE) ORDATE=DT
  1. I APP="ICD"!(APP="10D") S VAL=$$ONE^LEXU(IEN,ORDATE,APP)_U_$S(APP="ICD":"ICD-9-CM",1:"ICD-10-CM")
  1. I APP="CPT"!(APP="CHP") S VAL=$$CPTONE^LEXU(IEN,ORDATE)_U_"CPT-4"
  1. I $P(VAL,U)="",(APP="CHP") S VAL=$$CPCONE^LEXU(IEN,ORDATE)_U_"HCPCS"
  1. Q
  1. ADDRES ; Add the ORW/PXAPI RESOURCE device
  1. N X
  1. S X=$$RES^XUDHSET("ORW/PXAPI RESOURCE",,5,"CPRS to PCE transactions")
  1. Q
  1. GETSVC(NEWSVC,SVC,LOC,INP) ; Returns the correct Service Connected Category
  1. N DSS,ORWSVC
  1. S DSS=$P($G(^SC(+LOC,0)),U,7)
  1. Q:'+DSS
  1. M ORWSVC=SVC
  1. S NEWSVC=$$SVC^PXKCO(.ORWSVC,DSS,INP,LOC) ; DBIA #3225
  1. Q
  1. ICDVER(RESULT,ORDT) ; Get ICD codeset version (i.e., ICD-9-CM or ICD-10-CM)
  1. S ORDT=+$G(ORDT) S:'ORDT ORDT=DT
  1. S RESULT="ICD^ICD-9-CM"
  1. G:'$L($T(IMPDATE^LEXU)) ICDVERX
  1. I +$$IMPDATE^LEXU("10D")'>ORDT S RESULT="10D^ICD-10-CM"
  1. ICDVERX Q
  1. I10IMPDT(RESULT) ; Get ICD-10 Implementation Date
  1. S RESULT=""
  1. G:'$L($T(IMPDATE^LEXU)) I10IMPX
  1. S RESULT=$$IMPDATE^LEXU("10D")
  1. I10IMPX Q