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

ORQQPL3.m

Go to the documentation of this file. 
  1. ORQQPL3 ; ALB/PDR/REV ; Problem List RPC's ; 8-OCT-1998 09:08:49.29
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,148,173,243**;Dec 17, 1997;Build 242
  1.  ;
  1.  ;---------------- LIST PATIENT PROBLEMS ------------------------
  1.  ;
  1. PROBL(ROOT,DFN,CONTEXT)        ;  GET LIST OF PATIENT PROBLEMS
  1.  N DIWL,DIWR,DIWF
  1.  N ST,ORI,ORX
  1.  S (LCNT,NUM)=0
  1.  S DIWL=1,DIWR=48,DIWF="C48"
  1.  S CONTEXT=";;"_$G(CONTEXT)
  1.  I CONTEXT=";;" S CONTEXT=";;A"
  1.  S ST=$P(CONTEXT,";",3)
  1.  ;
  1.  I ST="R" D DELLIST(.ROOT,+DFN) ; show deleted only
  1.  I ST'="R"  D LIST(.ROOT,+DFN,ST) ; show others - don't trust ELSE here
  1.  ;
  1.  I ROOT(0)<1 D
  1.  . S LCNT=1
  1.  . S ROOT(1)="     "_$$PAD^ORCHTAB("No data available.",49)_"|"
  1.  Q
  1.  ;
  1.  ;
  1. LIST(GMPL,GMPDFN,GMPSTAT)       ; -- Returns list of problems for patient GMPDFN
  1.  ;    in GMPL(#)=ifn^status^description^ICD^onset^last modified^SC^SpExp^Condition^Loc^
  1.  ;                          loc.type^prov^service
  1.  ;     & GMPL(0)=number of problems returned
  1.  ; This is virtually same as LIST^GMPLUTL2 except that it appends the 
  1.  ; condition - T)ranscribed or P)ermanent,location,loc type,provider, service.
  1.  ;
  1.  N I,IFN,CNT,GMPL0,GMPL1,SP,ST,NUM,ONSET,ICD,LASTMOD,PRIO,DTREC
  1.  N SC,ORLIST,ORVIEW,GMPARAM,ORTOTAL,LIN,LOC,LT,PROV,SERV,HASCMT
  1.  N SCCOND,AO,IR,ENV,HNC,MST,CV,SHD,ORICD186,INACT
  1.  Q:$G(GMPDFN)'>0
  1.  S CNT=0,SP=""
  1.  S GMPARAM("QUIET")=1
  1.  S GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R"
  1.  S ORVIEW("ACT")=GMPSTAT
  1.  S ORVIEW("PROV")=0
  1.  S ORVIEW("VIEW")=""
  1.  S ORICD186=$$PATCH^XPDUTL("ICD*18.0*6")
  1.  ;
  1.  D GETPLIST^GMPLMGR1(.ORLIST,.ORTOTAL,.ORVIEW)
  1.  ;
  1.  F NUM=0:0 S NUM=$O(ORLIST(NUM)) Q:NUM'>0  D
  1.  . S IFN=+ORLIST(NUM) Q:IFN'>0
  1.  . S INACT=""
  1.  . S GMPL0=$G(^AUPNPROB(IFN,0))
  1.  . S GMPL1=$G(^AUPNPROB(IFN,1))
  1.  . S HASCMT=($D(^AUPNPROB(IFN,11,0))>0)
  1.  . S CNT=CNT+1
  1.  . I +ORICD186 D
  1.  . . S ICD=$$CODEC^ICDCODE(+GMPL0)
  1.  . . I '+$$STATCHK^ICDAPIU(ICD,DT) S INACT="#"
  1.  . E  D
  1.  . . S ICD=$P($G(^ICD9(+GMPL0,0)),U)
  1.  . S LASTMOD=$P(GMPL0,U,3)
  1.  . S ST=$P(GMPL0,U,12)
  1.  . S ONSET=$P(GMPL0,U,13)
  1.  . S SC=$S(+$P(GMPL1,U,10):"SC",$P(GMPL1,U,10)=0:"NSC",1:"")
  1.  . S AO=$S(+$P(GMPL1,U,11):"/AO",1:"")
  1.  . S IR=$S(+$P(GMPL1,U,12):"/IR",1:"")
  1.  . S ENV=$S(+$P(GMPL1,U,13):"/EC",1:"")
  1.  . S HNC=$S(+$P(GMPL1,U,15):"/HNC",1:"")
  1.  . S MST=$S(+$P(GMPL1,U,16):"/MST",1:"")
  1.  . S CV=$S(+$P(GMPL1,U,17):"/CV",1:"")
  1.  . S SHD=$S(+$P(GMPL1,U,18):"/SHD",1:"")
  1.  . S SCCOND=SC_AO_IR_ENV_HNC_MST_CV_SHD
  1.  . S LOC=$P(GMPL1,U,8)
  1.  . S DTREC=$P(GMPL1,U,9)
  1.  . S LT=""
  1.  . I LOC'="" S LT=$P($G(^SC(LOC,0)),"^",3),LOC=LOC_";"_$P($G(^SC(LOC,0)),U,1)
  1.  . S PROV=$P(GMPL1,U,5) ; responsible provider
  1.  . I PROV'="" S PROV=PROV_";"_$P($G(^VA(200,PROV,0)),U,1)
  1.  . S SERV=$P(GMPL1,U,6)
  1.  . I SERV=0 S SERV="" ; not sure how it gets set to 0, but need consistency in GUI
  1.  . I SERV'="" S SERV=SERV_";"_$P($G(^DIC(49,SERV,0)),U,1)
  1.  . S SP=""
  1.  . F I=11,12,13 S:$P(GMPL1,U,I) SP=SP_$S(I=11:"A",I=12:"I",1:"P")
  1.  . S PRIO=$P(GMPL1,U,14)
  1.  . S LIN=IFN_U_ST_U_$$PROBTEXT^GMPLX(IFN)_U_ICD_U_ONSET
  1.  . S LIN=LIN_U_LASTMOD_U_SC_U_SP_U_$P(GMPL1,U,2)
  1.  . S LIN=LIN_U_LOC_U_LT_U_PROV_U_SERV_U_PRIO_U_HASCMT_U_DTREC_U_SCCOND_U_INACT
  1.  . S GMPL(CNT)=LIN
  1.  S GMPL(0)=CNT
  1.  Q
  1.  ;
  1.  ;
  1.  ;------------------------------------- GET LIST OF DELETED PROBLEMS -----------------------------
  1.  ;
  1. DELLIST(RETURN,GMPDFN) ; GET LIST OF DELETED PROBLEMS
  1.  ; see GETPLIST^GMPLMGR1 and LIST^GMPUTL2
  1.  N S,IFN,I,L0,L1,ST,TXT,ICD,ONSET,MOD,SC,SP,LOC,LT,PROV,SERV,PRIO,HASCMT,DTREC
  1.  N SCCOND,AO,IR,ENV,HNC,MST,CV,SHD,ORICD186,INACT
  1.  S I=0,S=""
  1.  S ORICD186=$$PATCH^XPDUTL("ICD*18.0*6")
  1.  F  S S=$O(^AUPNPROB("ACTIVE",GMPDFN,S)) Q:S=""  D
  1.  . S IFN=""
  1.  . F  S IFN=$O(^AUPNPROB("ACTIVE",+GMPDFN,S,IFN)) Q:IFN=""  D
  1.  .. I $P($G(^AUPNPROB(IFN,1)),U,2)="H" D
  1.  ... S L0=$G(^AUPNPROB(IFN,0))
  1.  ... Q:L0=""
  1.  ... S INACT=""
  1.  ... S L1=$G(^AUPNPROB(IFN,1))
  1.  ... S ST=$P(L0,U,12)
  1.  ... S TXT=$$PROBTEXT^GMPLX(IFN)
  1.  ... I +ORICD186 D
  1.  ... . S ICD=$$CODEC^ICDCODE(+L0)
  1.  ... . I '+$$STATCHK^ICDAPIU(ICD,DT) S INACT="#"
  1.  ... E  D
  1.  ... . S ICD=$P($G(^ICD9(+L0,0)),U)
  1.  ... S ONSET=$P(L0,U,13)
  1.  ... S MOD=$P(L0,U,3)
  1.  ... S SC=$S(+$P(L1,U,10):"SC",$P(L1,U,10)=0:"NSC",1:"")
  1.  ... S AO=$S(+$P(L1,U,11):"/AO",1:"")
  1.  ... S IR=$S(+$P(L1,U,12):"/IR",1:"")
  1.  ... S ENV=$S(+$P(L1,U,13):"/EC",1:"")
  1.  ... S HNC=$S(+$P(L1,U,15):"/HNC",1:"")
  1.  ... S MST=$S(+$P(L1,U,16):"/MST",1:"")
  1.  ... S CV=$S(+$P(L1,U,17):"/CV",1:"")
  1.  ... S SHD=$S(+$P(L1,U,18):"/SHD",1:"")
  1.  ... S SCCOND=SC_AO_IR_ENV_HNC_MST_CV_SHD
  1.  ... S SP=$$GETSP
  1.  ... S LOC=$P(L1,U,8)
  1.  ... S LT=""
  1.  ... I LOC'="" S LT=$P($G(^SC(LOC,0)),"^",3)
  1.  ... S PROV=$P(L1,U,5) ; responsible provider
  1.  ... S SERV=$P(L1,U,6)
  1.  ... S PRIO=$P(L1,U,14)
  1.  ... S HASCMT=($D(^AUPNPROB(IFN,11,0))>0)
  1.  ... S DTREC=$P(L1,U,9)
  1.  ... S I=I+1
  1.  ... S RETURN(I)=IFN_U_ST_U_TXT_U_ICD_U_ONSET
  1.  ... S RETURN(I)=RETURN(I)_U_MOD_U_SC_U_SP_U_$P(L1,U,2)
  1.  ... S RETURN(I)=RETURN(I)_U_LOC_U_LT_U_PROV_U_SERV
  1.  ... S RETURN(I)=RETURN(I)_U_PRIO_U_HASCMT_U_DTREC_U_SCCOND_U_INACT
  1.  S RETURN(0)=I
  1.  Q
  1.  ;
  1. GETSP() ; GET EXPOSURES
  1.  N I
  1.  S SP=""
  1.  F I=11,12,13 S:$P(L1,U,I) SP=SP_$S(I=11:"A",I=12:"I",1:"P")
  1.  Q SP
  1.  ;
  1.  ; adapted from ^GMPLBLD3 ;9/96
  1.  ;
  1.  ; ----------------------- GET USER PROBLEM CATEGORIES --------------
  1.  ;
  1. CAT(TMP,ORDUZ,CLIN) ; Get user category list
  1.  N GSEQ,GCNT,GROUP,HDR,IFN,LCNT,ITEM,TG,GMPLSLST
  1.  ; S TG=$NAME(^TMP("GMPLMENU",$J)) ; put list in global for testing
  1.  S TG=$NAME(TMP) ; put list in local
  1.  K @TG
  1.  S (GSEQ,GCNT,LCNT)=0
  1.  ;
  1.  S GMPLSLST=$$GETUSLST(DUZ,CLIN)  ; get approp list for user
  1.  ; Build multiple of category\problems
  1.  ; Iterate categories
  1.  F  S GSEQ=$O(^GMPL(125.1,"C",+GMPLSLST,GSEQ)) Q:GSEQ'>0  D
  1.  . S IFN=$O(^GMPL(125.1,"C",+GMPLSLST,GSEQ,0)) Q:IFN'>0
  1.  . S ITEM=$G(^GMPL(125.1,IFN,0))
  1.  . S GROUP=+$P(ITEM,U,3)
  1.  . S HDR=GROUP_U_$P(ITEM,U,4,5)
  1.  . S GCNT=GCNT+1
  1.  . S @TG@(GCNT)=HDR ; put category into temp global
  1.  Q
  1.  ;
  1. GETUSLST(ORDUZ,CLIN) ; GET AN APPROPRIATE CATEGORY LIST FOR THE USER
  1.  N GMPLSLST
  1.  S GMPLSLST=$P($G(^VA(200,DUZ,125)),U,2)
  1.  ;I 'GMPLSLST D
  1.  I 'GMPLSLST,CLIN,$D(^GMPL(125,"C",+CLIN)) S GMPLSLST=$O(^(+CLIN,0))
  1.  ;. S GMPLSLST=$O(^VA(200,DUZ,+CLIN,0))  ;$O(^(+CLIN,0))
  1.  Q GMPLSLST
  1.  ;
  1.  ;----------------------- USER PROBLEM LIST --------------------------
  1.  ;
  1. PROB(TMP,GROUP) ; Get user problem list for given group
  1.  N PSEQ,PCNT,IFN,ITEM,TG,CODE,TEXT,ORICD186
  1.  ; S TG=$NAME(^TMP("GMPLMENU",$J)) ; put list in global for testing
  1.  S TG=$NAME(TMP) ; put list in local
  1.  K @TG
  1.  S LCNT=0
  1.  S ORICD186=$$PATCH^XPDUTL("ICD*18.0*6")
  1.  ;
  1.  ; iterate through problems in category
  1.  S (PSEQ,PCNT)=0
  1.  F  S PSEQ=$O(^GMPL(125.12,"C",GROUP,PSEQ)) Q:PSEQ'>0  D
  1.  . S IFN=$O(^GMPL(125.12,"C",GROUP,PSEQ,0)) Q:IFN'>0
  1.  . S ITEM=$G(^GMPL(125.12,IFN,0))
  1.  . S TEXT=$P(ITEM,U,4)
  1.  . ; SEE DD for GMPL(125.12,4 :
  1.  . ; "...code which is to be displayed... generally assumed to be ICD"
  1.  . S CODE=$P(ITEM,U,5)
  1.  . I +ORICD186,'+$$STATCHK^ICDAPIU(CODE,DT) Q
  1.  . S PCNT=PCNT+1
  1.  . ; RETURN:
  1.  . ; PROBLEM^DISPLAY TEXT^CODE^CODE IFN
  1.  . I +ORICD186 D
  1.  . . S @TG@(PCNT)=$P(ITEM,U,3,5)_U_$$CODEN^ICDCODE(CODE,80)
  1.  . E  D
  1.  . . S @TG@(PCNT)=$P(ITEM,U,3,5)_U_$$ICDCODE(CODE)
  1.  Q
  1.  ;
  1. ICDCODE(COD)    ; RETURN INTERNAL ICD FOR EXTERNAL CODE  (obsolete after CSV patches released - RV)
  1.  N CODIEN
  1.  I COD="" Q ""
  1.  S CODIEN=+$O(^ICD9("AB",$P(COD,U)_" ",0))
  1.  S:CODIEN'>0 CODIEN=+$O(^ICD9("AB",$P(COD,U)_"0 ",0))
  1.  Q CODIEN
  1.  ;
  1.  ;------------------ Filter Providers ---------------------
  1.  ;
  1. GETRPRV(RETURN,INP) ; GET LIST OF RESPONSIBLE PROVIDERS FROM PRBLM LIST 
  1.  ; RETURN - aa list of responsible providers from which to select for filtering
  1.  ; INP - array of problem list providers to select from
  1.  ;
  1.  N S
  1.  S S=""
  1.  F I=1:1 S S=$O(INP(S)) Q:S=""  D
  1.  . I INP(S)'="",$G(^VA(200,INP(S),0))'="" D  Q  ; get next
  1.  .. S RETURN(I)=INP(S)_U_$P(^VA(200,INP(S),0),U)
  1.  S RETURN(0)="-1"_U_"<None recorded>" ; return empty provider
  1.  Q
  1.  ;
  1.  ;---------------------------------------------------- GET FILTERED CLINIC LIST ------------------------
  1.  ;
  1. GETCLIN(RETURN,INP) ; Get FILTERED LIST OF CLINICS
  1.  ; RETURN NAMES FOR LIST OF CLINICS PASSED IN
  1.  N I,S
  1.  S S=""
  1.  F I=1:1 S S=$O(INP(S)) Q:S=""  D
  1.  . I INP(S)'="",$G(^SC(INP(S),0))'="" D  Q  ; get next
  1.  .. S RETURN(I)=INP(S)_U_$P(^SC(INP(S),0),U,1)
  1.  ;. S RETURN(I)="-1"_U_"None" ; return empty location
  1.  Q
  1.  ;
  1. GETSRVC(RETURN,INP) ; GET FILTERED LIST OF INPATIENT SERVICES
  1.  ; RETURN NAMES FOR LIST OF IEN PASSED IN
  1.  N I,S
  1.  S S=""
  1.  F I=1:1 S S=$O(INP(S)) Q:S=""  D
  1.  . I INP(S)'="",$G(^DIC(49,INP(S),0))'="" D  Q  ; get next
  1.  .. S RETURN(I)=INP(S)_U_$P(^DIC(49,INP(S),0),U,1)
  1.  ;. S RETURN(I)="-1"_U_"None" ; return empty service
  1.  Q