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