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;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
  1.  ;
  1.  ; DBIA 2950   LOOK^LEXA          ^TMP("LEXFND",$J)
  1.  ; DBIA 1609   CONFIG^LEXSET      ^TMP("LEXSCH",$J)
  1.  ; DBIA 1365   DSELECT^GMPLENFM   ^TMP("IB",$J)
  1.  ; DBIA 3991   $$STATCHK^ICDAPIU
  1.  ;Modified - IHS/MSC/PLS - 08/12/10 - Line VISIT+2
  1.  Q
  1. VISIT(LST,CLINIC,ORDATE) ; get list of visit types for clinic
  1.  S:'+$G(ORDATE) ORDATE=DT
  1.  ;IHS/MSC/PLS - 08/12/2010 - Removed additional parameters
  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(LST,CLINIC,ORDATE) ; get list of diagnoses for clinic
  1.  S:'+$G(ORDATE) ORDATE=DT
  1.  D GETLST^IBDF18A(CLINIC,"DG SELECT ICD-9 DIAGNOSIS CODES","LST",,,,ORDATE)
  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.  K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
  1.  S:'+$G(ORDATE) ORDATE=DT
  1.  D DSELECT^GMPLENFM  ;DBIA 1365
  1.  N ORPROB,ORPROBIX,ORPRCNT
  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.  . S ORPROB=$P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3)
  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.  ; DBIA   10082     NAME: ICD DIAGNOSIS FILE
  1.  N ORWINDEX,ORITEM
  1.  S ORWINDEX=0
  1.  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)]""
  1.  . S ORITEM=^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX)
  1.  . I '+$$STATCHK^ICDAPIU($P(ORITEM,"^",3),ORDATE) S $P(ORITEM,"^",11)="#"  ;DBIA 3991
  1.  . S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX)=ORITEM
  1.  S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=ORPRCNT
  1.  S GLST="^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 X0,X12,VISIT
  1.  S X0=$G(^TIU(8925,+IEN,0)),X12=$G(^(12)),VISIT=$P(X12,U,7)
  1.  I +VISIT S VAL=$$VSTRBLD^TIUSRVP(VISIT) I 1
  1.  E  S VAL=$P(X12,U,11)_";"_$P(X0,U,7)_";"_$P(X0,U,13)
  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) ; delete PCE info when deleting a note
  1.  N VISIT,ORCOUNT
  1.  N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC,ZTSYNC,ZTSK
  1.  I '$D(^TMP("ORWPCE",$J,VSTR)) S VAL=0 Q  ; no PCE data saved yet
  1.  I $P(VSTR,";",3)="H" S VAL=0 Q           ; leave inpatient alone
  1.  I $L($T(DOCCNT^TIUSRVLV))=0 S VAL=0 Q    ; leave if no tiu entry point
  1.  D DOCCNT^TIUSRVLV(.ORCOUNT,DFN,VSTR)     ; Do not delete if another
  1.  I ORCOUNT>0 S VAL=0 Q                    ; title points to visit
  1.  S ZTIO="ORW/PXAPI RESOURCE",ZTRTN="DQDEL^ORWPCE1",ZTDTH=$H
  1.  S (ZTSAVE("VSTR"),ZTSAVE("DFN"))="",ZTDESC="CPRS Delete Note/PCE"
  1.  S ZTSYNC="ORW"_VSTR
  1.  D ^%ZTLOAD I '$D(ZTSK) D DQDEL^ORWPCE1
  1.  Q
  1. SAVE(OK,PCELIST,NOTEIEN,ORLOC) ; save PCE information
  1.  N VSTR,GMPLUSER
  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.  Q
  1. LEX(LST,X,APP,ORDATE) ; return list after lexicon lookup
  1.  N LEX,ILST,I,IEN
  1.  S:APP="CPT" APP="CHP" ; LEX PATCH 10
  1.  S:'+$G(ORDATE) ORDATE=DT
  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)) S LST(1)="-1^No matches found." Q
  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.  K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J),^TMP("LEXSCH",$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" S VAL=$$ICDONE^LEXU(IEN,ORDATE)
  1.  I APP="CPT"!(APP="CHP") S VAL=$$CPTONE^LEXU(IEN,ORDATE) ; LEX PATCH 10
  1.  I VAL="",(APP="CHP") S VAL=$$CPCONE^LEXU(IEN,ORDATE) ; LEX PATCH 10
  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