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

GMPLENFM.m

Go to the documentation of this file. 
  1. GMPLENFM ; SLC/MKB/KER -- Problem List Enc Form utilities ;11/20/12  15:03
  1.  ;;2.0;Problem List;**3,4,7,26,35,36**;Aug 25, 1994;Build 65
  1.  ;
  1.  ; External References
  1.  ;   DBIA  1609  CONFIG^LEXSET
  1.  ;   DBIA  3990  $$ICDDX^ICDCODE
  1.  ;   DBIA 10006  ^DIC
  1.  ;
  1. ACTIVE ; List of Active Problems for DFN
  1.  ;   Input variables:
  1.  ;             DFN               Patient ID (Required)
  1.  ;             [GMPLINDT]        Date of Interest (Optional - defaults to today)
  1.  ;                                 This is the date to use for evalutation of the
  1.  ;                                 Activation status of ICD-9-CM and SNOMED CT codes
  1.  ;
  1.  ;   Sets Global Array:
  1.  ;   ^TMP("IB",$J,"INTERFACES",DFN,"GMP PATIENT ACTIVE PROBLEMS",#) =
  1.  ;
  1.  ;   Piece 1:  Problem text
  1.  ;         2:  ICD code
  1.  ;         3:  Date of Onset     00/00/00 format
  1.  ;         4:  SC/NSC/""         serv-conn/not sc/unknown
  1.  ;         5:  Y/N/""            serv-conn/not sc/unknown
  1.  ;         6:  A/I/E/H/M/C/S/""  If problem is flagged as:
  1.  ;                               A - Agent Orange
  1.  ;                               I - Ionizing Radiation
  1.  ;                               E - Environmental Contaminants
  1.  ;                               H - Head/Neck Cancer
  1.  ;                               M - Mil Sexual Trauma
  1.  ;                               C - Combat Vet
  1.  ;                               S - SHAD
  1.  ;                                 - None
  1.  ;         7:  Special Exposure  Full text of piece 6
  1.  ;         8:  SNOMED-CT Concept Code
  1.  ;         9:  SNOMED-CT Designation Code
  1.  ;        10:  VHAT Concept VUID
  1.  ;        11:  VHAT Designation VUID
  1.  ;        12:  Code Status (#  -> ICD code inactive, $ -> SNOMED CT inactive,
  1.  ;                          #$ -> Both ICD & SNOMED CT inactive, else "")
  1.  ;
  1.  N IFN,PROB,CNT,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL
  1.  N GMPDFN,NODE,GMPDT
  1.  Q:$G(DFN)'>0  S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0))
  1.  S GMPDT=$G(GMPINDT,$$DT^XLFDT)
  1.  S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1
  1.  S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")=""
  1.  D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
  1.  F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0  D
  1.  . N GMPL0,GMPL1,GMPL800,CODESTAT,ICDC,ICDI,SCTC,SCTD,VHATC,VHATD
  1.  . S IFN=GMPLIST(NUM) Q:IFN'>0
  1.  . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),CODESTAT=""
  1.  . S ICDC=$P($$ICDDX^ICDCODE(+GMPL0),U,2),CODESTAT=CODESTAT_$S(+$$STATCHK^ICDAPIU(ICDC,GMPDT):"",1:"#")
  1.  . S ICDI=0 F  S ICDI=$O(^AUPNPROB(IFN,803,ICDI)) Q:+ICDI'>0  D
  1.  .. N ICDMC S ICDMC=$P($G(^AUPNPROB(IFN,803,ICDI,0)),U)
  1.  .. S ICDC=ICDC_"/"_ICDMC
  1.  .. I CODESTAT'["#" S CODESTAT=CODESTAT_$S(+$$STATCHK^ICDAPIU(ICDMC,GMPDT):"",1:"#")
  1.  . S SCTC=$P(GMPL800,U),SCTD=$P(GMPL800,U,2),VHATC=$P(GMPL800,U,3),VHATD=$P(GMPL800,U,4)
  1.  . S CODESTAT=CODESTAT_$S(+$$STATCHK^LEXSRC2(SCTC,GMPDT):"",1:"$")
  1.  . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1
  1.  . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB
  1.  . S PROB=PROB_U_ICDC
  1.  . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10)
  1.  . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^")
  1.  . S PROB=PROB_U_$$TXFCTR(GMPL1)_U_SCTC_U_SCTD_U_VHATC_U_VHATD_U_CODESTAT
  1.  . S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",CNT)=PROB
  1.  S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",0)=CNT
  1.  Q
  1.  ;
  1. SELECT ; Select Common Problems
  1.  ;   Sets Global Array:
  1.  ;   ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")
  1.  ;   Piece 1:  Pointer to Clinical Lexicon
  1.  ;         2:  Problem Text
  1.  ;         3:  ICD Code (null if unknown)
  1.  ;
  1.  N X,Y,DIC,PROB D CONFIG^LEXSET("","PLS")
  1.  K ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")
  1.  S DIC("A")="Select PROBLEM: ",DIC(0)="AEQM",DIC="^LEX(757.01,"
  1.  D ^DIC Q:+Y<0  S PROB=Y I +Y'>1 S PROB=+Y_U_X
  1.  S PROB=PROB_U_$G(Y(1))
  1.  S ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")=PROB
  1.  Q
  1.  ;
  1. DSELECT ; List of Active Problems for DFN
  1.  ;   Input variables:
  1.  ;             DFN               Patient ID (Required)
  1.  ;             [GMPLINDT]        Date of Interest (Optional - defaults to today)
  1.  ;                                 This is the date to use for evalutation of the
  1.  ;                                 Activation status of ICD-9-CM and SNOMED CT codes
  1.  ;
  1.  ;   Sets Global Array"
  1.  ;   ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",#) =
  1.  ;
  1.  ;   Piece 1:  Problem IEN
  1.  ;         2:  Problem Text
  1.  ;         3:  ICD code
  1.  ;         4:  Date of Onset     00/00/00 format
  1.  ;         5:  SC/NSC/""         serv-conn/not sc/unknown
  1.  ;         6:  Y/N/""            serv-conn/not sc/unknown
  1.  ;         7:  A/I/E/H/M/C/S/""  If problem is flagged as:
  1.  ;                               A - Agent Orange
  1.  ;                               I - Ionizing Radiation
  1.  ;                               E - Environmental Contaminants
  1.  ;                               H - Head/Neck Cancer
  1.  ;                               M - Mil Sexual Trauma
  1.  ;                               C - Combat Vet
  1.  ;                               S - SHAD
  1.  ;                                 - None
  1.  ;         8:  Special Exposure  Full text of piece 6
  1.  ;         9:  SNOMED-CT Concept Code
  1.  ;        10:  SNOMED-CT Designation Code
  1.  ;        11:  VHAT Concept VUID
  1.  ;        12:  VHAT Designation VUID
  1.  ;        13:  Code Status (#  -> ICD code inactive, $ -> SNOMED CT inactive,
  1.  ;                          #$ -> Both ICD & SNOMED CT inactive, else "")
  1.  ;
  1.  N IFN,PROB,CNT,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL,GMPDFN,NODE,GMPDT
  1.  Q:$G(DFN)'>0  S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0))
  1.  S GMPDT=$G(GMPINDT,$$DT^XLFDT)
  1.  S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1
  1.  S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")=""
  1.  D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
  1.  F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0  D
  1.  . N GMPL0,GMPL1,GMPL800,CODESTAT,ICDC,ICDI,SCTC,SCTD,VHATC,VHATD
  1.  . S IFN=GMPLIST(NUM) Q:IFN'>0
  1.  . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),CODESTAT=""
  1.  . S ICDC=$P($$ICDDX^ICDCODE(+GMPL0),U,2)
  1.  . S:ICDC]"" CODESTAT=CODESTAT_$S(+$$STATCHK^ICDAPIU(ICDC,GMPDT):"",1:"#")
  1.  . S ICDI=0 F  S ICDI=$O(^AUPNPROB(IFN,803,ICDI)) Q:+ICDI'>0  D
  1.  .. N ICDMC S ICDMC=$P($G(^AUPNPROB(IFN,803,ICDI,0)),U) Q:ICDMC']""
  1.  .. S ICDC=ICDC_"/"_ICDMC
  1.  .. I CODESTAT'["#" S CODESTAT=CODESTAT_$S(+$$STATCHK^ICDAPIU(ICDMC,GMPDT):"",1:"#")
  1.  . S SCTC=$P(GMPL800,U),SCTD=$P(GMPL800,U,2),VHATC=$P(GMPL800,U,3),VHATD=$P(GMPL800,U,4)
  1.  . S:SCTC]"" CODESTAT=CODESTAT_$S(+$$STATCHK^LEXSRC2(SCTC,GMPDT):"",1:"$")
  1.  . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1
  1.  . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB
  1.  . S PROB=IFN_U_PROB
  1.  . S PROB=PROB_U_ICDC
  1.  . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10)
  1.  . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^")
  1.  . S PROB=PROB_U_$$TXFCTR(GMPL1)_U_SCTC_U_SCTD_U_VHATC_U_VHATD_U_CODESTAT
  1.  . S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",CNT)=PROB
  1.  S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=CNT
  1.  Q
  1.  ;
  1. TXFCTR(GMPL1) ;Determine Treatment Factor, if any
  1.  N NXTTF,TXFACTOR
  1.  S TXFACTOR="^"
  1.  F NXTTF=11,12,13,15,16,17,18 I $P(GMPL1,U,NXTTF) S TXFACTOR=$P("A^Agent Orange;I^Ionizing Radiation;E^Env. Contaminants;;H^Head/Neck Cancer;M^Mil Sexual Trauma;C^Combat Vet;S^SHAD",";",NXTTF-10) Q
  1.  Q TXFACTOR