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