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