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

GMPLDISP.m

Go to the documentation of this file. 
  1. GMPLDISP ; ISL/MKB,JER,TC - Problem List detailed display ;06/08/12  15:10
  1.  ;;2.0;Problem List;**21,26,35,36**;Aug 25, 1994;Build 65
  1.  ;
  1.  ; External References
  1.  ;   DBIA  3106  ^DIC(49
  1.  ;   DBIA  3990  $$ICDDX^ICDCODE
  1.  ;   DBIA 10040  ^SC(  file 44
  1.  ;   DBIA 10060  ^VA(200
  1.  ;   DBIA 10116  $$SETSTR^VALM1
  1.  ;   DBIA 10117  CLEAN^VALM10
  1.  ;   DBIA 10117  CNTRL^VALM10
  1.  ;   DBIA 10103  $$FMTE^XLFDT
  1.  ;   DBIA 10103  $$HTFM^XLFDT
  1.  ;   DBIA 10104  $$REPEAT^XLFSTR
  1.  ;
  1. EN ; Init Variables (need GMPLSEL,GMPLNO) and List Array
  1.  G:'$D(GMPLSEL) ERROR G:'$G(GMPLNO) ERROR
  1.  S GMPI=+$G(GMPI)+1 I GMPI>GMPLNO D  Q
  1.  . W !!,"There are no more problems that have been selected to view!",! S VALMBCK="" H 2
  1.  S GMPLNUM=$P(GMPLSEL,",",GMPI) G:GMPLNUM'>0 ERROR
  1.  S GMPIFN=$P($G(^TMP("GMPLIDX",$J,+GMPLNUM)),U,2) G:GMPIFN'>0 ERROR
  1.  W !!,"Retrieving current data for problem #"_GMPLNUM_" ...",!
  1.  ;
  1. PROB ; Display problem GMPIFN
  1.  N LINE,STR,I,J,L,TEXT,NOTE,GMPLDT,GMPL0,GMPL1,GMPL800,GMPL803,X,Y,IDT,FAC,AIFN,SP,LCNT
  1.  N NIFN,SCTC,SCTD,SCTT,PROVNAR,ICDDESC,DESCR,ICD,PNTXT
  1.  G:'$G(GMPIFN) ERROR D CLEAN^VALM10
  1.  S GMPL0=$G(^AUPNPROB(GMPIFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),GMPL803=$G(^(803,0)),LCNT=1,SP=""
  1.  S GMPLDT=$S(+$P(GMPL1,U,9):$P(GMPL1,U,9),+$P(GMPL0,U,8):$P(GMPL0,U,8),1:DT)
  1.  F I=11,12,13,15,16,17,18 S:+$P(GMPL1,U,I) SP=SP_$S(I=11:"AGENT ORANGE",I=12:"RADIATION",I=13:"ENV CONTAMINANTS",I=15:"HEAD/NECK CANCER",I=16:"MIL SEXUAL TRAUMA",I=17:"COMBAT VET",1:"SHAD")_U
  1.  F  Q:$E(SP,$L(SP))'="^"  S SP=$E(SP,1,($L(SP)-1))
  1.  S ICD=$P($$ICDDX^ICDCODE(+GMPL0),U,2)  ;ICD=ICD-9-CM Code
  1.  S PROVNAR=$$PROBTEXT^GMPLX(GMPIFN)  ;PROVNAR=Provider Narrative
  1.  S ICDDESC=$$ICDDESC^GMPLUTL2($G(ICD),$P(GMPL0,U,8))  ;ICDDESC=ICD Description
  1.  S SCTC=$P(GMPL800,U),SCTD=$P(GMPL800,U,2)  ;SCTC=SNOMED-CT Concept Code,SCTD=SNOMED-CT Designation Code
  1.  S:(PROVNAR["SCT") PNTXT=$P(PROVNAR," (SCT")
  1.  D WRAP^GMPLX($G(PROVNAR),65,.TEXT)
  1.  I TEXT=1 S GMPDT(LCNT,0)="  Problem: "_TEXT(1)
  1.  E  I TEXT>1 D
  1.  . S GMPDT(LCNT,0)="  Problem: "_TEXT(1)
  1.  . F I=2:1:TEXT S LCNT=LCNT+1,GMPDT(LCNT,0)=$S($L($G(SCTC))!$L($G(SCTD)):"           ",1:"               ")_TEXT(I)
  1.  I $L($G(SCTC)) S SCTT=$$SCTTEXT^GMPLUTL2(SCTC,$P(GMPL0,U,8))  ;SCTT=SNOMED-CT Preferred Text
  1.  I $L($G(SCTC))!$L($G(SCTD)) D
  1.  . I ($L($G(SCTT))>0)&(PNTXT'=$G(SCTT)) D
  1.  . . D WRAP^GMPLX($G(SCTT),65,.SCTTTXT) S LCNT=LCNT+1,GMPDT(LCNT,0)="SNOMED-CT: "_SCTTTXT(1)
  1.  . . I SCTTTXT>1 F L=2:1:SCTTTXT S LCNT=LCNT+1,GMPDT(LCNT,0)="           "_SCTTTXT(L)
  1.  . I $L($G(ICD)) S LCNT=LCNT+1,GMPDT(LCNT,0)=" ICD-9-CM: "_$G(ICD)_" ["_$G(ICDDESC)_"]"
  1.  E  D
  1.  . D WRAP^GMPLX($G(ICDDESC),65,.DESCR) S LCNT=LCNT+1,GMPDT(LCNT,0)="ICD-9-CM TEXT: "_DESCR(1)
  1.  . I DESCR>1 F J=2:1:DESCR S LCNT=LCNT+1,GMPDT(LCNT,0)="               "_DESCR(J)
  1.  I $L($G(GMPL803))>0 D
  1.  . N DA S DA=0 F  S DA=$O(^AUPNPROB(GMPIFN,803,DA)) Q:'+DA  D
  1.  . . N ICDN,ICDNDX S ICDN=$P($G(^AUPNPROB(GMPIFN,803,DA,0)),U),ICDNDX=$$ICDDESC^GMPLUTL2($G(ICDN))
  1.  . . S LCNT=LCNT+1,GMPDT(LCNT,0)="         : "_$G(ICDN)_$$PAD^GMPLX(ICDN,6)_" ["_$G(ICDNDX)_"]"
  1.  S LCNT=LCNT+1,GMPDT(LCNT,0)="       "
  1. PR1 ; Onset
  1.  ;   SC Condition
  1.  ;   Status
  1.  ;   Exposure
  1.  ;   Provider
  1.  ;   Service/Clinic
  1.  S LINE="    Onset: "_$S($P(GMPL0,U,13):$$EXTDT^GMPLX($P(GMPL0,U,13)),1:"date unknown"),STR=""
  1.  S:GMPVA STR="SC Condition: "_$S(+$P(GMPL1,U,10):"YES",$P(GMPL1,U,10)=0:"NO",1:"unknown")
  1.  S LINE=$$SETSTR^VALM1(STR,LINE,49,30),LCNT=LCNT+1,GMPDT(LCNT,0)=LINE
  1.  S X=$P(GMPL0,U,12),LINE="   Status: "_$S(X="A":"ACTIVE",1:"INACTIVE")
  1.  I X="A",$L($P(GMPL1,U,14)) S LINE=LINE_"/"_$S($P(GMPL1,U,14)="A":"ACUTE",1:"CHRONIC")
  1.  I X="I",$P(GMPL1,U,7) S LINE=LINE_", Resolved "_$$EXTDT^GMPLX($P(GMPL1,U,7))
  1.  S STR="",LCNT=LCNT+1
  1.  S:GMPVA STR="    Exposure: "_$S('$L(SP):"none",1:$P(SP,U))
  1.  S LINE=$$SETSTR^VALM1(STR,LINE,49,30),GMPDT(LCNT,0)=LINE
  1.  S LINE=" Provider: "_$P($G(^VA(200,+$P(GMPL1,U,5),0)),U),LCNT=LCNT+1,STR=""
  1.  I GMPVA,$L(SP,U)>1 S STR=$P(SP,U,2)
  1.  S LINE=$$SETSTR^VALM1(STR,LINE,63,16),GMPDT(LCNT,0)=LINE
  1.  I $E(GMPLVIEW("VIEW"))="S" S LINE="  Service: "_$P($G(^DIC(49,+$P(GMPL1,U,6),0)),U)
  1.  E  S LINE="   Clinic: "_$P($G(^SC(+$P(GMPL1,U,8),0)),U)
  1.  S LCNT=LCNT+1,STR="" I GMPVA,$L(SP,U)>2 S STR=$P(SP,U,3)
  1.  S LINE=$$SETSTR^VALM1(STR,LINE,63,16),GMPDT(LCNT,0)=LINE
  1.  S LCNT=LCNT+1,GMPDT(LCNT,0)="       "
  1. PR2 ; Recorded
  1.  ;   Entered
  1.  ;   Provider Narrative
  1.  ;   ICD code
  1.  S LINE=" Recorded: "_$S($P(GMPL1,U,9):$$EXTDT^GMPLX($P(GMPL1,U,9)),1:"date unknown")
  1.  S:$P(GMPL1,U,4) LINE=LINE_", by "_$P($G(^VA(200,+$P(GMPL1,U,4),0)),U)
  1.  S LCNT=LCNT+1,GMPDT(LCNT,0)=LINE
  1.  S LINE="  Entered: "_$$EXTDT^GMPLX($P(GMPL0,U,8))
  1.  S LINE=LINE_", by "_$P($G(^VA(200,+$P(GMPL1,U,3),0)),U),LCNT=LCNT+1
  1.  S:GMPARAM("VER")&($P(GMPL1,U,2)="T") LINE=LINE_"  <unconfirmed>"
  1.  S GMPDT(LCNT,0)=LINE
  1.  S LCNT=LCNT+1,GMPDT(LCNT,0)="       "
  1. PR3 ; Comments
  1.  S LCNT=LCNT+1,GMPDT(LCNT,0)="Comments:"
  1.  D CNTRL^VALM10(LCNT,1,8,IOUON,IOUOFF)
  1.  ;     By Facility
  1.  F FAC=0:0 S FAC=$O(^AUPNPROB(GMPIFN,11,FAC)) Q:+FAC'>0  D
  1.  . I 'FAC S LCNT=LCNT+1,GMPDT(LCNT,0)="   <None>" G PR4
  1.  . F NIFN=0:0 S NIFN=$O(^AUPNPROB(GMPIFN,11,FAC,11,NIFN)) Q:+NIFN'>0  D
  1.  . . S NOTE=$G(^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0)) Q:NOTE=""
  1.  . . S LINE=$J($$EXTDT^GMPLX($P(NOTE,U,5)),10)_": "_$P(NOTE,U,3)
  1.  . . S LCNT=LCNT+1,GMPDT(LCNT,0)=LINE
  1.  . . I $P(NOTE,U,6) S LINE="            "_$P($G(^VA(200,+$P(NOTE,U,6),0)),U),LCNT=LCNT+1,GMPDT(LCNT,0)=LINE
  1.  S:'($G(NOTE)) LCNT=LCNT+1,GMPDT(LCNT,0)="   <None>"
  1. PR4 ; Audit Trail
  1.  S LCNT=LCNT+1,GMPDT(LCNT,0)="       "
  1.  S LCNT=LCNT+1,GMPDT(LCNT,0)="History:"
  1.  D CNTRL^VALM10(LCNT,1,7,IOUON,IOUOFF)
  1.  I '$D(^GMPL(125.8,"B",GMPIFN)) S LCNT=LCNT+1,GMPDT(LCNT,0)="   <No changes>" G PRQ
  1.  F IDT=0:0 S IDT=$O(^GMPL(125.8,"AD",GMPIFN,IDT)) Q:IDT'>0  D
  1.  . F AIFN=0:0 S AIFN=$O(^GMPL(125.8,"AD",GMPIFN,IDT,AIFN)) Q:AIFN'>0  D DT^GMPLHIST
  1. PRQ ; Header Node
  1.  S VALMCNT=LCNT,GMPDT(0)=VALMCNT,VALMSG=$$MSG^GMPLX,VALMBG=1,VALMBCK="R"
  1.  Q
  1.  ;
  1. HDR ; Header Code (uses GMPDFN, GMPIFN)
  1.  N LASTMOD,PAT S PAT=$P(GMPDFN,U,2)_"  ("_$P(GMPDFN,U,3)_")"
  1.  S LASTMOD=$S($G(GMPIFN):$P(^AUPNPROB(GMPIFN,0),U,3),1:$E($$HTFM^XLFDT($H),1,12))
  1.  S LASTMOD="Last Updated: "_$$FMTE^XLFDT(LASTMOD)
  1.  S VALMHDR(1)=PAT_$$REPEAT^XLFSTR(" ",(79-$L(PAT)-$L(LASTMOD)))_LASTMOD
  1.  Q
  1.  ;
  1. HELP ; Help Code
  1.  N X W !!?4,"You may view detailed information here on this problem;"
  1.  W !?4,"more data may be available by entering 'Next Screen'."
  1.  W !?4,"If you have selected multiple problems to view, you may"
  1.  W !?4,"enter 'Continue to Next Selected Problem'; to return to"
  1.  W !?4,"the patient's problem list, enter 'Quit to Problem List'."
  1.  W !!,"Press <return> to continue ... " R X:DTIME
  1.  S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
  1.  Q
  1.  ;
  1. DEFLT() ; Default Action, using GMPI and GMPLNO
  1.  I GMPI<GMPLNO Q "Continue to Next Selected Problem"
  1.  Q "Quit to Problem List"
  1.  ;
  1. ERROR ; Error Message - drop into EXIT
  1.  W !!,"ERROR -- Cannot continue ... Returning to Problem List.",!
  1.  S VALMBCK="Q" H 1
  1. EXIT ; Exit Code
  1.  K GMPDT Q