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

ORWPCE2.m

Go to the documentation of this file.
  1. ORWPCE2 ; ISL/JM,RV,JER - wrap calls to PCE ;Jul 07, 2021@07:47:42
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,116,173,195,243,306,361,405**;Dec 17, 1997;Build 211
  1. GETSET(ORWLST,ORWFILE,ORWFIELD,ORWNULL) ;gets set of codes
  1. ; ORWLST(n)=code^text for code
  1. N ORWPCE,ORWPCEL,ORWPCEC,ORWPCELO,ORWPCEHI,ORWPCECD,ORWPCET
  1. S ORWPCELO="abcdefghijklmnopqrstuvwxyz"
  1. S ORWPCEHI="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  1. D FIELD^DID(ORWFILE,ORWFIELD,"","POINTER","ORWPCE","ORWPCE")
  1. S ORWPCEL=$L(ORWPCE("POINTER"),";")-1
  1. F ORWPCEC=1:1:ORWPCEL D
  1. . S ORWPCECD=$P($P(ORWPCE("POINTER"),";",ORWPCEC),":",1)
  1. . S ORWPCET=$P($P(ORWPCE("POINTER"),";",ORWPCEC),":",2)
  1. . S ORWLST(ORWPCEC)=ORWPCECD_"^"_$E(ORWPCET)_$TR($E(ORWPCET,2,99),ORWPCEHI,ORWPCELO)
  1. S:$G(ORWNULL) ORWLST(0)="@^(None selected)"
  1. Q
  1. ;
  1. IMMTYPE(ORWLST,ORDT) ;get the list of active immunizations
  1. N IEN,CNT,BINDEX S (IEN,CNT,BINDEX)=0
  1. S:'$G(ORDT) ORDT=DT
  1. F S BINDEX=$O(^AUTTIMM("B",BINDEX)) Q:BINDEX']"" F S IEN=$O(^(BINDEX,IEN)) Q:'+IEN D
  1. . I $D(^AUTTIMM(IEN,0))#2,+$P(^(0),"^",7)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
  1. . ;I $D(^AUTTIMM(IEN,0))#2,+$$SCREEN^XTID(9999999.14,,IEN,ORDT)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
  1. Q
  1. ;
  1. SKTYPE(ORWLST,ORDT) ;get the list of active skin test
  1. N IEN,CNT,BINDEX S (IEN,CNT,BINDEX)=0
  1. S:'$G(ORDT) ORDT=DT
  1. F S BINDEX=$O(^AUTTSK("B",BINDEX)) Q:BINDEX']"" F S IEN=$O(^(BINDEX,IEN)) Q:'+IEN D
  1. . I $D(^AUTTSK(IEN,0))#2,+$P(^(0),"^",3)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
  1. . ;I $D(^AUTTSK(IEN,0))#2,+$$SCREEN^XTID(9999999.28,,IEN,ORDT)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
  1. Q
  1. ;
  1. EDTTYPE(ORWLST) ;get the list of active education topics
  1. N IEN,CNT,BINDEX S (IEN,CNT,BINDEX)=0
  1. F S BINDEX=$O(^AUTTEDT("B",BINDEX)) Q:BINDEX']"" F S IEN=$O(^(BINDEX,IEN)) Q:'+IEN I $D(^AUTTEDT(IEN,0))#2,+$P(^(0),"^",3)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
  1. Q
  1. ;
  1. HFTYPE(ORWLST,ADDCATS) ;get the list of active health factors
  1. N IEN,CNT,BINDEX,REC
  1. S (IEN,CNT,BINDEX)=0,ADDCATS=+$G(ADDCATS)
  1. F S BINDEX=$O(^AUTTHF("B",BINDEX)) Q:BINDEX']"" D
  1. .F S IEN=$O(^AUTTHF("B",BINDEX,IEN)) Q:'+IEN D
  1. ..S REC=$G(^AUTTHF(IEN,0))
  1. ..I +$P(REC,U,11) S REC=""
  1. ..I 'ADDCATS,$P(REC,U,10)="C" S REC=""
  1. ..I REC'="" D
  1. ...S CNT=CNT+1,ORWLST(CNT)=IEN_U_$P(REC,U)
  1. ...I ADDCATS S ORWLST(CNT)=ORWLST(CNT)_U_$P(REC,U,10)_U_$P(REC,U,3)
  1. Q
  1. ;
  1. EXAMTYPE(ORWLST) ;get the list of active exams
  1. N IEN,CNT,BINDEX S (IEN,CNT,BINDEX)=0
  1. F S BINDEX=$O(^AUTTEXAM("B",BINDEX)) Q:BINDEX']"" F S IEN=$O(^(BINDEX,IEN)) Q:'+IEN I $D(^AUTTEXAM(IEN,0))#2,+$P(^(0),"^",4)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
  1. Q
  1. ;
  1. TRTTYPE(ORWLST) ;get the list of active treatments
  1. N IEN,CNT,BINDEX S (IEN,CNT,BINDEX)=0
  1. F S BINDEX=$O(^AUTTTRT("B",BINDEX)) Q:BINDEX']"" F S IEN=$O(^(BINDEX,IEN)) Q:'+IEN I $D(^AUTTTRT(IEN,0))#2,+$P(^(0),"^",4)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$P(^(0),"^")
  1. Q
  1. ;
  1. ACTIVPRV(ORRETURN,ORWPROV,ORWDT) ;get if provider is active or not
  1. S ORRETURN=$$ACTIVPRV^PXAPI(ORWPROV,ORWDT)
  1. Q
  1. GETVISIT(VISIT,IEN,DFN,VSITSTR) ;Get the visit IEN
  1. I +$G(IEN)<1 D I 1
  1. .S VISIT=$$GETENC^PXAPI(DFN,$P(VSITSTR,";",2),$P(VSITSTR,";"))
  1. E D
  1. .I $P($G(^TIU(8925,IEN,12)),U,7)>0 S VISIT=$P($G(^TIU(8925,IEN,12)),U,7) Q
  1. .S VISIT=$P(^TIU(8925,IEN,0),U,3)
  1. Q
  1. GAFOK(ORY) ; Returns true if all supporting MH GAF Code exists
  1. S ORY=0
  1. I $T(GAFHX^YSGAFAPI)'="",$T(ENT^YSGAFAP1)'="" S ORY=1
  1. Q
  1. MHCLINIC(ORY,ORIEN) ; See if this is a mental health clinic
  1. I $T(MHCLIN^SDUTL2)="" S ORY=1
  1. E S ORY=$$MHCLIN^SDUTL2(ORIEN)
  1. Q
  1. LOADGAF(ORY,ORINPUT) ; Retrieve GAF scores
  1. D GAFHX^YSGAFAPI(.ORY,.ORINPUT)
  1. Q
  1. SAVEGAF(ORY,ORINPUT) ; Save new GAF score
  1. N ORDATA
  1. D ENT^YSGAFAP1(.ORDATA,.ORINPUT)
  1. S ORY=($G(ORDATA(1))="[DATA]")
  1. Q
  1. FORCE(ORY,USER,LOC) ; Retrieve FORCE GUI PCE Entry for a given User/Location
  1. N SRV,ORTMP,ORERR
  1. S USER=$G(USER,DUZ)
  1. S SRV=$P($G(^VA(200,USER,5)),U)
  1. D GETLST^XPAR(.ORTMP,"USR^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","ORWPCE FORCE PCE ENTRY","Q",.ORERR)
  1. S ORY=+$P($G(ORTMP(1)),U,2)
  1. Q
  1. HASCPT(ORY,ORLIST) ; Returns true if there are any mapped CPT Codes
  1. N IEN,IDX,FOUND
  1. S IDX=0
  1. F S IDX=$O(ORLIST(IDX)) Q:'+IDX D
  1. . S FOUND=0
  1. . S IEN=$$FIND1^DIC(811.1,"","QX",ORLIST(IDX))
  1. . I +IEN S FOUND=+$$GET1^DIQ(811.1,IEN,.05,"I")
  1. . S ORY(IDX)=ORLIST(IDX)_"="_FOUND
  1. Q
  1. ASKPCE(ORY,USER,LOC) ; Returns ORWPCE ASK ENCOUNTER UPDATE parameter value IA#4213
  1. N SRV,ORTMP,ORERR
  1. S USER=$G(USER,DUZ)
  1. S SRV=$P($G(^VA(200,USER,5)),U)
  1. D GETLST^XPAR(.ORTMP,"USR^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","ORWPCE ASK ENCOUNTER UPDATE","Q",.ORERR)
  1. S ORY=+$P($G(ORTMP(1)),U,2)
  1. Q
  1. GAFURL(URL) ;Returns the MH GAF Web Page URL
  1. S URL=""
  1. I $T(GAFURL^YTAPI5)'="" D
  1. .N ORY
  1. .D GAFURL^YTAPI5(.ORY)
  1. .I $G(ORY(1))="[DATA]" S URL=$G(ORY(2))
  1. Q
  1. MHTESTOK(ORY) ; Returns True if all supporting MH Test APIs exist
  1. D GAFOK(.ORY)
  1. I +ORY,+$G(DUZ),$T(SAVEIT^YTAPI1)'="",$T(PREVIEW^YTAPI4)'="",$T(SHOWALL^YTAPI3)'="",$T(LISTONE^YTAPI)'="",$T(MHS^PXRMRPCC)'="",$T(MHR^PXRMRPCC)'="",$T(MH^PXRMRPCC)'="" D
  1. . N SRV
  1. . S SRV=$P($G(^VA(200,DUZ,5)),U)
  1. . S ORY=$$GET^XPAR(DUZ_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM MENTAL HEALTH ACTIVE",1,"Q")
  1. . I +ORY S ORY=1
  1. Q
  1. MHATHRZD(ORY,TEST,USER) ;Indicates that user can score test
  1. N ORYS,ORANS
  1. I $T(PRIVL^YTAPI5)="" S ORY=1 Q
  1. S ORY=0
  1. S ORYS("CODE")=TEST
  1. S ORYS("STAFF")=USER
  1. D PRIVL^YTAPI5(.ORANS,.ORYS)
  1. I $G(ORANS(1))="[DATA]" S ORY=+$P($G(ORANS(2)),U,1)
  1. Q
  1. ANYTIME(ORY) ;Returns status of the ORWPCE ANYTIME ENCOUNTERS parameter
  1. N SRV
  1. S SRV=$P($G(^VA(200,DUZ,5)),U)
  1. S ORY=$$GET^XPAR(DUZ_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","ORWPCE ANYTIME ENCOUNTERS",1,"Q")
  1. I +ORY S ORY=1
  1. Q
  1. AUTOVSIT(ORY,LOC) ; Returns TRUE if automatic selection of Visit Type
  1. N SRV
  1. S SRV=$P($G(^VA(200,DUZ,5)),U)
  1. S ORY=$$GET^XPAR(DUZ_";VA(200,^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS","ORWPCE DISABLE AUTO VISIT TYPE",1,"Q")
  1. I +ORY S ORY=1
  1. S ORY='ORY
  1. Q
  1. DOCHKOUT(ORY,LOC) ; Returns TRUE if automatic selection of Visit Type
  1. N SRV
  1. S SRV=$P($G(^VA(200,DUZ,5)),U)
  1. S ORY=$$GET^XPAR(DUZ_";VA(200,^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS","ORWPCE DISABLE AUTO CHECKOUT",1,"Q")
  1. I +ORY S ORY=1
  1. S ORY='ORY
  1. Q
  1. CHKOUT(LOC) ; Returns TRUE if automatic selection of Visit Type
  1. N ORY
  1. D DOCHKOUT(.ORY,LOC)
  1. Q ORY
  1. EXCLUDED(ORY,LOC,TYPE) ; Returns list of excluded PCE data elements
  1. N SRV,PARAM
  1. S PARAM=$S(TYPE=1:"IMMUNIZATIONS",TYPE=2:"SKIN TESTS",TYPE=3:"PATIENT ED",TYPE=4:"HEALTH FACTORS",TYPE=5:"EXAMS",1:"")
  1. Q:PARAM=""
  1. S SRV=$P($G(^VA(200,DUZ,5)),U)
  1. S PARAM="ORWPCE EXCLUDE "_PARAM
  1. D GETLST^XPAR(.ORY,"USR^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG",PARAM,"Q",.ORERR)
  1. Q
  1. ISCLINIC(ORY,ORLOC) ; Returns TRUE if location is a clinic
  1. N ORTYP
  1. S ORY=0
  1. S ORTYP=$$GET1^DIQ(44,+ORLOC,2,"I")
  1. I (ORTYP="C")!(ORTYP="M") S ORY=1
  1. Q
  1. HNCOK(ORY) ; Returns true if Head and/or Neck Cancer is enabled
  1. S ORY=0
  1. I $$PATCH^XPDUTL("DG*5.3*397"),$$PATCH^XPDUTL("SD*5.3*244"),$$PATCH^XPDUTL("PX*1.0*111"),$$PATCH^XPDUTL("IVM*2.0*46") S ORY=1
  1. Q
  1. ;
  1. CODACTIV(ORY,ORCODE,ORAPP,ORDATE) ; Is code active on the given date?
  1. ; Remote procedure: ORWPCE ACTIVE CODE
  1. ; ORCODE = ICD or CPT code to be checked
  1. ; ORAPP = "ICD", "GMPX" or "CHP"
  1. ; ORDATE = Date to be checked (defaults to current date)
  1. S:'+$G(ORDATE) ORDATE=DT
  1. S ORY=1
  1. I ORAPP="ICD" D I 1
  1. . N ORI F ORI=1:1:$L(ORCODE,"/") S ORY=+$$STATCHK^ICDXCODE("DIAGNOSIS",$P(ORCODE,"/",ORI),ORDATE) Q:'ORY
  1. I ORAPP="GMPX" D I 1
  1. . N LEX
  1. . S ORY=+$$STATCHK^LEXSRC2(ORCODE,ORDATE,.LEX)
  1. E I ORAPP="CHP" D
  1. . S ORY=+$$STATCHK^ICPTAPIU(ORCODE,ORDATE)
  1. Q
  1. ICDACTIV(ORCODE,ORDATE) ; Check for active ICD code
  1. D CODACTIV(.ORY,ORCODE,"ICD",$G(ORDATE))
  1. Q +ORY
  1. CPTACTIV(ORCODE,ORDATE) ; Check for active CPT code
  1. D CODACTIV(.ORY,ORCODE,"CHP",$G(ORDATE))
  1. Q +ORY
  1. CXNOSHOW(ORY,ORDOCIEN) ; Should workload requirement be skipped for this note's visit?
  1. ; RETURN VALUE: 0=SKIP ALL GUI WORKLOAD REQUIREMENTS
  1. ; 1=CONTINUE WITH OTHER GUI WORKLOAD LOGIC
  1. N ORTIU
  1. D DOCPARM^TIUSRVP1(.ORTIU,ORDOCIEN) ; DBIA #4331
  1. S ORY=+$$CHKWKL^TIUPXAP2(ORDOCIEN,ORTIU(0)) ; DBIA #4332
  1. Q