ORWPCE ; SLC/JM/REV - wrap calls to PCE and AICS;24-Aug-2010 08:46;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,173,190,195,215,243,1007**;Dec 17, 1997;Build 47
;
; DBIA 2950 LOOK^LEXA ^TMP("LEXFND",$J)
; DBIA 1609 CONFIG^LEXSET ^TMP("LEXSCH",$J)
; DBIA 1365 DSELECT^GMPLENFM ^TMP("IB",$J)
; DBIA 3991 $$STATCHK^ICDAPIU
;Modified - IHS/MSC/PLS - 08/12/10 - Line VISIT+2
Q
VISIT(LST,CLINIC,ORDATE) ; get list of visit types for clinic
S:'+$G(ORDATE) ORDATE=DT
;IHS/MSC/PLS - 08/12/2010 - Removed additional parameters
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(LST,CLINIC,ORDATE) ; get list of diagnoses for clinic
S:'+$G(ORDATE) ORDATE=DT
D GETLST^IBDF18A(CLINIC,"DG SELECT ICD-9 DIAGNOSIS CODES","LST",,,,ORDATE)
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
K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
S:'+$G(ORDATE) ORDATE=DT
D DSELECT^GMPLENFM ;DBIA 1365
N ORPROB,ORPROBIX,ORPRCNT
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
. S ORPROB=$P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3)
. 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)
; DBIA 10082 NAME: ICD DIAGNOSIS FILE
N ORWINDEX,ORITEM
S ORWINDEX=0
F S ORWINDEX=$O(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX)) Q:'ORWINDEX D:$P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX),"^",1)]""
. S ORITEM=^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX)
. I '+$$STATCHK^ICDAPIU($P(ORITEM,"^",3),ORDATE) S $P(ORITEM,"^",11)="#" ;DBIA 3991
. S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX)=ORITEM
S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=ORPRCNT
S GLST="^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 X0,X12,VISIT
S X0=$G(^TIU(8925,+IEN,0)),X12=$G(^(12)),VISIT=$P(X12,U,7)
I +VISIT S VAL=$$VSTRBLD^TIUSRVP(VISIT) I 1
E S VAL=$P(X12,U,11)_";"_$P(X0,U,7)_";"_$P(X0,U,13)
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) ; delete PCE info when deleting a note
N VISIT,ORCOUNT
N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC,ZTSYNC,ZTSK
I '$D(^TMP("ORWPCE",$J,VSTR)) S VAL=0 Q ; no PCE data saved yet
I $P(VSTR,";",3)="H" S VAL=0 Q ; leave inpatient alone
I $L($T(DOCCNT^TIUSRVLV))=0 S VAL=0 Q ; leave if no tiu entry point
D DOCCNT^TIUSRVLV(.ORCOUNT,DFN,VSTR) ; Do not delete if another
I ORCOUNT>0 S VAL=0 Q ; title points to visit
S ZTIO="ORW/PXAPI RESOURCE",ZTRTN="DQDEL^ORWPCE1",ZTDTH=$H
S (ZTSAVE("VSTR"),ZTSAVE("DFN"))="",ZTDESC="CPRS Delete Note/PCE"
S ZTSYNC="ORW"_VSTR
D ^%ZTLOAD I '$D(ZTSK) D DQDEL^ORWPCE1
Q
SAVE(OK,PCELIST,NOTEIEN,ORLOC) ; save PCE information
N VSTR,GMPLUSER
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
Q
LEX(LST,X,APP,ORDATE) ; return list after lexicon lookup
N LEX,ILST,I,IEN
S:APP="CPT" APP="CHP" ; LEX PATCH 10
S:'+$G(ORDATE) ORDATE=DT
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)) S LST(1)="-1^No matches found." Q
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)
K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J),^TMP("LEXSCH",$J)
Q
LEXCODE(VAL,IEN,APP,ORDATE) ; return code for a lexicon entry
S VAL=""
S:'+$G(ORDATE) ORDATE=DT
I APP="ICD" S VAL=$$ICDONE^LEXU(IEN,ORDATE)
I APP="CPT"!(APP="CHP") S VAL=$$CPTONE^LEXU(IEN,ORDATE) ; LEX PATCH 10
I VAL="",(APP="CHP") S VAL=$$CPCONE^LEXU(IEN,ORDATE) ; LEX PATCH 10
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
ORWPCE ; SLC/JM/REV - wrap calls to PCE and AICS;24-Aug-2010 08:46;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,173,190,195,215,243,1007**;Dec 17, 1997;Build 47
+2 ;
+3 ; DBIA 2950 LOOK^LEXA ^TMP("LEXFND",$J)
+4 ; DBIA 1609 CONFIG^LEXSET ^TMP("LEXSCH",$J)
+5 ; DBIA 1365 DSELECT^GMPLENFM ^TMP("IB",$J)
+6 ; DBIA 3991 $$STATCHK^ICDAPIU
+7 ;Modified - IHS/MSC/PLS - 08/12/10 - Line VISIT+2
+8 QUIT
VISIT(LST,CLINIC,ORDATE) ; get list of visit types for clinic
+1 IF '+$GET(ORDATE)
SET ORDATE=DT
+2 ;IHS/MSC/PLS - 08/12/2010 - Removed additional parameters
+3 ;,,,,ORDATE)
DO GETLST^IBDF18A(CLINIC,"DG SELECT VISIT TYPE CPT PROCEDURES","LST")
+4 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(LST,CLINIC,ORDATE) ; get list of diagnoses for clinic
+1 IF '+$GET(ORDATE)
SET ORDATE=DT
+2 DO GETLST^IBDF18A(CLINIC,"DG SELECT ICD-9 DIAGNOSIS CODES","LST",,,,ORDATE)
+3 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 KILL ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
+2 IF '+$GET(ORDATE)
SET ORDATE=DT
+3 ;DBIA 1365
DO DSELECT^GMPLENFM
+4 NEW ORPROB,ORPROBIX,ORPRCNT
+5 SET ORPRCNT=0
+6 SET ORPROBIX=0
+7 ;DBIA 1365
FOR
SET ORPROBIX=$ORDER(^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX))
IF 'ORPROBIX
QUIT
Begin DoDot:1
+8 SET ORPROB=$PIECE(^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3)
+9 IF $EXTRACT(ORPROB,1)="$"
SET ORPROB=$EXTRACT(ORPROB,2,255)
+10 IF '$DATA(ORPROB(ORPROB))
Begin DoDot:2
+11 SET ORPROB(ORPROB)=""
+12 SET ORPRCNT=ORPRCNT+1
+13 SET $PIECE(^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3)=ORPROB
End DoDot:2
+14 IF '$TEST
KILL ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX)
End DoDot:1
+15 ; DBIA 10082 NAME: ICD DIAGNOSIS FILE
+16 NEW ORWINDEX,ORITEM
+17 SET ORWINDEX=0
+18 FOR
SET ORWINDEX=$ORDER(^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX))
IF 'ORWINDEX
QUIT
IF $PIECE(^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX),"^",1)]""
Begin DoDot:1
+19 SET ORITEM=^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX)
+20 ;DBIA 3991
IF '+$$STATCHK^ICDAPIU($PIECE(ORITEM,"^",3),ORDATE)
SET $PIECE(ORITEM,"^",11)="#"
+21 SET ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX)=ORITEM
End DoDot:1
+22 SET ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=ORPRCNT
+23 SET GLST="^TMP(""IB"","_$JOB_",""INTERFACES"",""GMP SELECT PATIENT ACTIVE PROBLEMS"")"
+24 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 X0,X12,VISIT
+2 SET X0=$GET(^TIU(8925,+IEN,0))
SET X12=$GET(^(12))
SET VISIT=$PIECE(X12,U,7)
+3 IF +VISIT
SET VAL=$$VSTRBLD^TIUSRVP(VISIT)
IF 1
+4 IF '$TEST
SET VAL=$PIECE(X12,U,11)_";"_$PIECE(X0,U,7)_";"_$PIECE(X0,U,13)
+5 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) ; delete PCE info when deleting a note
+1 NEW VISIT,ORCOUNT
+2 NEW ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC,ZTSYNC,ZTSK
+3 ; no PCE data saved yet
IF '$DATA(^TMP("ORWPCE",$JOB,VSTR))
SET VAL=0
QUIT
+4 ; leave inpatient alone
IF $PIECE(VSTR,";",3)="H"
SET VAL=0
QUIT
+5 ; leave if no tiu entry point
IF $LENGTH($TEXT(DOCCNT^TIUSRVLV))=0
SET VAL=0
QUIT
+6 ; Do not delete if another
DO DOCCNT^TIUSRVLV(.ORCOUNT,DFN,VSTR)
+7 ; title points to visit
IF ORCOUNT>0
SET VAL=0
QUIT
+8 SET ZTIO="ORW/PXAPI RESOURCE"
SET ZTRTN="DQDEL^ORWPCE1"
SET ZTDTH=$HOROLOG
+9 SET (ZTSAVE("VSTR"),ZTSAVE("DFN"))=""
SET ZTDESC="CPRS Delete Note/PCE"
+10 SET ZTSYNC="ORW"_VSTR
+11 DO ^%ZTLOAD
IF '$DATA(ZTSK)
DO DQDEL^ORWPCE1
+12 QUIT
SAVE(OK,PCELIST,NOTEIEN,ORLOC) ; save PCE information
+1 NEW VSTR,GMPLUSER
+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 SET ZTIO="ORW/PXAPI RESOURCE"
SET ZTRTN="DQSAVE^ORWPCE1"
SET ZTDTH=$HOROLOG
+7 SET ZTSAVE("PCELIST(")=""
SET ZTDESC="Data from CPRS to PCE"
+8 SET ZTSAVE("GMPLUSER")=""
SET ZTSAVE("NOTEIEN")=""
SET ZTSAVE("DUZ")=""
+9 IF VSTR'["E"
SET ZTSYNC="ORW"_VSTR
+10 SET ZTSAVE("ORLOC")=""
+11 DO ^%ZTLOAD
IF '$DATA(ZTSK)
DO DQSAVE^ORWPCE1
+12 QUIT
LEX(LST,X,APP,ORDATE) ; return list after lexicon lookup
+1 NEW LEX,ILST,I,IEN
+2 ; LEX PATCH 10
IF APP="CPT"
SET APP="CHP"
+3 IF '+$GET(ORDATE)
SET ORDATE=DT
+4 ;DBIA 1609
DO CONFIG^LEXSET(APP,APP,ORDATE)
+5 IF APP="CHP"
Begin DoDot:1
+6 ; Set the filter for CPT only using CS APIs - format is the same as for DIC("S")
+7 ;DBIA 1609
SET ^TMP("LEXSCH",$JOB,"FIL",0)="I $L($$CPTONE^LEXU(+Y,$G(ORDATE)))!($L($$CPCONE^LEXU(+Y,$G(ORDATE))))"
+8 ; Set Applications Default Flag (Lexicon can not overwrite filter)
+9 SET ^TMP("LEXSCH",$JOB,"ADF",0)=1
End DoDot:1
+10 DO LOOK^LEXA(X,APP,1,"",ORDATE)
+11 IF '$DATA(LEX("LIST",1))
SET LST(1)="-1^No matches found."
QUIT
+12 SET LST(1)=LEX("LIST",1)
SET ILST=1
+13 SET (I,IEN)=""
+14 ;DBIA 2950
FOR
SET I=$ORDER(^TMP("LEXFND",$JOB,I))
IF I=""
QUIT
Begin DoDot:1
+15 FOR
SET IEN=$ORDER(^TMP("LEXFND",$JOB,I,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+16 SET ILST=ILST+1
SET LST(ILST)=IEN_U_^TMP("LEXFND",$JOB,I,IEN)
End DoDot:2
End DoDot:1
+17 KILL ^TMP("LEXFND",$JOB),^TMP("LEXHIT",$JOB),^TMP("LEXSCH",$JOB)
+18 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"
SET VAL=$$ICDONE^LEXU(IEN,ORDATE)
+4 ; LEX PATCH 10
IF APP="CPT"!(APP="CHP")
SET VAL=$$CPTONE^LEXU(IEN,ORDATE)
+5 ; LEX PATCH 10
IF VAL=""
IF (APP="CHP")
SET VAL=$$CPCONE^LEXU(IEN,ORDATE)
+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
