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

GMPLUTL2.m

Go to the documentation of this file.
  1. GMPLUTL2 ; ISL/MKB,KER,JER,TC -- PL Utilities (OE/TIU) ;02/16/17 12:21
  1. ;;2.0;Problem List;**10,18,21,26,35,36,42,45,49**;Aug 25, 1994;Build 43
  1. ;
  1. ; External References
  1. ; DBIA 348 ^DPT( file #2
  1. ; ICR 5699 $$ICDDATA^ICDXCODE
  1. ; ICR 5747 $$SAB^ICDEX,$$CODECS^ICDEX,$$CSI^ICDEX
  1. ; DBIA 10040 ^SC( file #44
  1. ; DBIA 10060 ^VA(200,$$GET1^DIQ(200
  1. ; DBIA 2716 $$GETSTAT^DGMSTAPI
  1. ; DBIA 3457 $$GETCUR^DGNTAPI
  1. ; DBIA 10062 7^VADPT
  1. ; DBIA 10062 DEM^VADPT
  1. ; DBIA 10118 EN^VALM
  1. ; DBIA 10116 CLEAR^VALM1
  1. ; DBIA 10103 $$HTFM^XLFDT
  1. ;
  1. LIST(GMPL,GMPDFN,GMPSTAT,GMPCOMM) ; Returns list of Problems for Patient
  1. D LIST^GMPLUTL3
  1. Q
  1. ;
  1. DETAIL(IFN,GMPL) ; Returns Detailed Data for Problem
  1. ;
  1. ; Input IFN Pointer to Problem file #9000011
  1. ;
  1. ; Output GMPL Array, passed by reference
  1. ; GMPL("DATA NAME") = External Format of Value
  1. ;
  1. ; GMPL("DIAGNOSIS") ICD Code
  1. ; GMPL("ICDD") ICD Description
  1. ; GMPL("CSYS") Coding System (#80202) [ex: 10D (ICD-10) & ICD (ICD-9)]
  1. ; GMPL("DTINTEREST") Date of Interest (#80201)
  1. ; GMPL("PATIENT") Patient Name
  1. ; GMPL("MODIFIED") Date Last Modified
  1. ; GMPL("NARRATIVE") Provider Narrative
  1. ; GMPL("ENTERED") Date Entered ^ Entered by
  1. ; GMPL("STATUS") Status
  1. ; GMPL("PRIORITY") Priority Acute/Chronic
  1. ; GMPL("ONSET") Date of Onset
  1. ; GMPL("PROVIDER") Responsible Provider
  1. ; GMPL("RECORDED") Date Recorded ^ Recorded by
  1. ; GMPL("CONDITION") Patient Condition (#1.02)
  1. ; GMPL("RESOLVED") Date Resolved (#1.07)
  1. ; GMPL("CLINIC") Hospital Location
  1. ; GMPL("SERVICE") Service (#1.06)
  1. ; GMPL("FACILITY") Facility ID ^ Facility Name (#.06)
  1. ; GMPL("SC") Service Connected SC/NSC/""
  1. ; GMPL("SCTC") SNOMED-CT Concept Code
  1. ; GMPL("SCTD") SNOMED-CT Designation Code
  1. ; GMPL("SCTT") SNOMED-CT Preferred Text
  1. ; GMPL("VHATC") VHAT Concept Code
  1. ; GMPL("VHATD") VHAT Designation Code
  1. ; GMPL("VHATT") VHAT Preferred Text
  1. ;
  1. ; GMPL("ICD9MLTP") = #
  1. ; GMPL("ICD9MLTP",CNT) = ICD-9-CM/ICD-10-CM Code^ICD-9-CM/ICD-10-CM Description^ICD Coding System
  1. ;
  1. ; GMPL("EXPOSURE") = #
  1. ; GMPL("EXPOSURE",X)="AGENT ORANGE"
  1. ; GMPL("EXPOSURE",X)="RADIATION"
  1. ; GMPL("EXPOSURE",X)="ENV CONTAMINANTS"
  1. ; GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER"
  1. ; GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA"
  1. ; GMPL("EXPOSURE",X)="COMBAT VET"
  1. ; GMPL("EXPOSURE",X)="SHAD"
  1. ;
  1. ; GMPL("COMMENT") = #
  1. ; GMPL("COMMENT",CNT) = Date ^ Author ^ Text of Note
  1. ;
  1. N GMPL0,GMPL1,GMPL800,GMPL802,GMPL803,GMPLP,X,I,FAC,CNT,NIFN,GMPLNTDT,GMPLATHR,GMPLTEXT Q:'$D(^AUPNPROB(IFN,0))
  1. K ^TMP("GMPLCMT",$J)
  1. S GMPLP=+($$PTR^GMPLUTL4)
  1. S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),GMPL802=$G(^(802)),GMPL803=$G(^(803,0))
  1. S GMPL("DTINTEREST")=$S(+$P(GMPL802,U,1):$P(GMPL802,U,1),1:$P(GMPL0,U,8)),GMPL("CSYS")=$S($P(GMPL802,U,2)]"":$P(GMPL802,U,2),1:$$SAB^ICDEX($$CSI^ICDEX(80,+GMPL0),GMPL("DTINTEREST")))
  1. S GMPL("DIAGNOSIS")=$P($$ICDDATA^ICDXCODE(GMPL("CSYS"),+GMPL0,GMPL("DTINTEREST"),"I"),U,2)
  1. S GMPL("FACILITY")=$$RESOLVE(IFN,".06","IE")
  1. S GMPL("ICDD")=$$ICDDESC(GMPL("DIAGNOSIS"),GMPL("DTINTEREST"),GMPL("CSYS"))
  1. S GMPL("PATIENT")=$P($G(^DPT(+$P(GMPL0,U,2),0)),U)
  1. S GMPL("MODIFIED")=$$EXTDT^GMPLX($P(GMPL0,U,3))
  1. S GMPL("NARRATIVE")=$$PROBTEXT^GMPLX(IFN)
  1. S GMPL("ENTERED")=$$EXTDT^GMPLX($P(GMPL0,U,8))_U_$P($G(^VA(200,+$P(GMPL1,U,3),0)),U)
  1. S X=$P(GMPL0,U,12),GMPL("STATUS")=$S(X="A":"ACTIVE",1:"INACTIVE")
  1. S X=$S(X'="A":"",1:$P(GMPL1,U,14)),GMPL("PRIORITY")=$S(X="A":"ACUTE",X="C":"CHRONIC",1:"")
  1. S GMPL("ONSET")=$$EXTDT^GMPLX($P(GMPL0,U,13))
  1. S GMPL("CONDITION")=$$RESOLVE(IFN,"1.02","E")
  1. S GMPL("PROVIDER")=$P($G(^VA(200,+$P(GMPL1,U,5),0)),U)
  1. S GMPL("RECORDED")=$$EXTDT^GMPLX($P(GMPL1,U,9))_U_$P($G(^VA(200,+$P(GMPL1,U,4),0)),U)
  1. S GMPL("RESOLVED")=$$EXTDT^GMPLX($P(GMPL1,U,7))
  1. S GMPL("CLINIC")=$P($G(^SC(+$P(GMPL1,U,8),0)),U)
  1. S GMPL("SERVICE")=$$RESOLVE(IFN,1.06,"E")
  1. S GMPL("SCTC")=$P(GMPL800,U),GMPL("SCTD")=$P(GMPL800,U,2)
  1. I $L($G(GMPL("SCTC"))) S GMPL("SCTT")=$P($$SCTTEXT(GMPL("SCTC"),$P(GMPL0,U,8),"SCT"),U)
  1. S GMPL("VHATC")=$P(GMPL800,U,3),GMPL("VHATD")=$P(GMPL800,U,4)
  1. I $L($G(GMPL("VHATC"))) S GMPL("VHATT")=$$SCTTEXT(GMPL("VHATC"),$P(GMPL0,U,8),"VHAT")
  1. S GMPL("ICD9MLTP")=""
  1. I $L($G(GMPL803))>0 D
  1. . N DA,ICDDESC S (CNT,DA)=0,GMPL("ICD9MLTP")=0 F S DA=$O(^AUPNPROB(IFN,803,DA)) Q:'+DA D
  1. . . S X=$G(^AUPNPROB(IFN,803,DA,0)),ICDDESC=$$ICDDESC($P(X,U),$P(X,U,3),$P(X,U,2))
  1. . . S CNT=CNT+1,GMPL("ICD9MLTP",CNT)=$P(X,U)_U_$G(ICDDESC)_U_$P(X,U,2)
  1. . S GMPL("ICD9MLTP")=CNT
  1. S GMPL("SC")=$S($P(GMPL1,U,10):"YES",$P(GMPL1,U,10)=0:"NO",1:"UNKNOWN")
  1. S GMPL("EXPOSURE")=0
  1. I $P(GMPL1,U,11) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="AGENT ORANGE",GMPL("EXPOSURE")=X
  1. I $P(GMPL1,U,12) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="RADIATION",GMPL("EXPOSURE")=X
  1. I $P(GMPL1,U,13) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="ENV CONTAMINANTS",GMPL("EXPOSURE")=X
  1. I $P(GMPL1,U,15) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER",GMPL("EXPOSURE")=X
  1. I $P(GMPL1,U,16) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA",GMPL("EXPOSURE")=X
  1. I $P(GMPL1,U,17) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="COMBAT VET",GMPL("EXPOSURE")=X
  1. I $P(GMPL1,U,18)&(GMPLP'>0) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="SHAD",GMPL("EXPOSURE")=X
  1. S (FAC,CNT)=0,GMPL("COMMENT")=0
  1. F FAC=0:0 S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D
  1. . F NIFN=0:0 S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D
  1. . . S X=$G(^AUPNPROB(IFN,11,FAC,11,NIFN,0))
  1. . . S GMPLNTDT=$P(X,U,5),GMPLATHR=$P(X,U,6),GMPLTEXT=$P(X,U,3)
  1. . . S ^TMP("GMPLCMT",$J,NIFN)=$$EXTDT^GMPLX(GMPLNTDT)_U_$$GET1^DIQ(200,""_+GMPLATHR_",",.01)_U_GMPLTEXT
  1. S NIFN=""
  1. F S NIFN=$O(^TMP("GMPLCMT",$J,NIFN),-1) Q:NIFN="" D
  1. . S CNT=CNT+1,GMPL("COMMENT",CNT)=^TMP("GMPLCMT",$J,NIFN)
  1. K ^TMP("GMPLCMT",$J)
  1. S GMPL("COMMENT")=CNT D AUDIT
  1. Q
  1. ;
  1. RESOLVE(IEN,FIELD,FORMAT) ; Call GET1^DIQ to resolve field values
  1. ; Input: IEN = Record #
  1. ; FIELD = Field # in PROBLEMS file #9000011
  1. ; FORMAT = "I"nternal, "E"xternal, or "IE" -> both
  1. ; Output: GMPLY = value as specified by format
  1. N GMPLY
  1. S IEN=IEN_","
  1. S GMPLY=$$GET1^DIQ(9000011,IEN,FIELD,FORMAT)
  1. S:FORMAT="IE" GMPLY=GMPLY_U_$$GET1^DIQ(9000011,IEN,FIELD,"E")
  1. Q GMPLY
  1. AUDIT ; 14 Sep 99 - MA - Add audit trail to OE Problem List.
  1. ; Called from DETAIL, requires IFN and sets GMPL("AUDIT")
  1. N IDT,AIFN,X0,X1,FLD,CNT
  1. S CNT=0,GMPL("AUDIT")=CNT
  1. F IDT=0:0 S IDT=$O(^GMPL(125.8,"AD",IFN,IDT)) Q:IDT'>0 D
  1. . F AIFN=0:0 S AIFN=$O(^GMPL(125.8,"AD",IFN,IDT,AIFN)) Q:AIFN'>0 D
  1. .. S X0=$G(^GMPL(125.8,AIFN,0)),X1=$G(^(1)) Q:'$L(X0)
  1. .. S FLD=$$FLDNAME(+$P(X0,U,2))
  1. .. S CNT=CNT+1
  1. .. S GMPL("AUDIT",CNT,0)=$P(X0,U,2)_U_FLD_U_$P(X0,U,3,8)
  1. .. ; = pointer#^fld name^date mod^who mod^old^new^reason^prov
  1. .. S:$L(X1) GMPL("AUDIT",CNT,1)=X1
  1. S GMPL("AUDIT")=CNT
  1. Q
  1. ;
  1. FLDNAME(NUM) ; Returns field name for display
  1. N NAME,NM1,NM2,I,J S J=0,NAME=""
  1. S NM1=".01^.05^.12^.13^1.01^1.02^1.04^1.05^1.06^1.07^1.08^1.09^1.1^1.11^1.12^1.13^1.14^1.15^1.16^1.17^1.18^80001^80002^80003^80004^80005^302^1101"
  1. F I=1:1:$L(NM1,U) I +$P(NM1,U,I)=+NUM S J=I Q
  1. G:J'>0 FNQ
  1. S NM2="DIAGNOSIS^PROVIDER NARRATIVE^STATUS^DATE OF ONSET^PROBLEM^CONDITION^RECORDING PROVIDER^RESPONSIBLE PROVIDER"
  1. S NM2=NM2_"^SERVICE^DATE RESOLVED^CLINIC^DATE RECORDED^SERVICE CONNECTED^AGENT ORANGE EXP^RADIATION EXP^ENV CONTAMINANTS EXP"
  1. S NM2=NM2_"^IMMEDIACY^HEAD & NECK CANCER^MIL SEX TRAUMA^COMBAT VET^SHIPBOARD HAZARD EXP^SNOMED CT CONCEPT^SNOMED CT DESIGNATION"
  1. S NM2=NM2_"^VHAT CONCEPT^VHAT DESIGNATION^SNOMED CT/ICD MAP STATUS^SECONDARY DIAGNOSIS^NOTE"
  1. S NAME=$P(NM2,U,J)
  1. FNQ Q NAME
  1. ;
  1. ADD(DFN,LOC,GMPROV) ; -- Interactive LMgr action to add new problem
  1. N X,Y,GMPDFN,GMPVA,GMPVAMC,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST,GMPCV,GMPSHD
  1. N GMPARAM,GMPLVIEW,GMPLUSER,GMPCLIN,GMPLSLST,GMPQUIT,VALMCC,GMPSAVED,GMPCLPAR
  1. Q:'DFN Q:'LOC D SETVARS
  1. S GMPLSLST=$$GET^XPAR(DUZ_";VA(200,","ORQQPL SELECTION LIST",1),VALMCC=0
  1. I +GMPCLIN S GMPCLPAR=$$GET^XPAR(+GMPCLIN_";SC(","ORQQPL SELECTION LIST",1)
  1. I 'GMPLSLST,+GMPCLPAR S GMPLSLST=GMPCLPAR
  1. I GMPLSLST D Q
  1. . S $P(GMPLSLST,U,2)=$P($G(^GMPL(125,+GMPLSLST,0)),U)
  1. . D EN^VALM("GMPL LIST MENU")
  1. F D ADD^GMPL1 Q:$D(GMPQUIT) K DUOUT,DTOUT,GMPSAVED W !!,">>> Please enter another problem, or press <return> to exit."
  1. Q
  1. ;
  1. SETVARS ; -- Define GMP* variables used in ADD and EDIT
  1. N VA,VADM,VAEL,VASV,X
  1. Q:'DFN D DEM^VADPT,7^VADPT
  1. S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")_$S(VADM(6):U_+VADM(6),1:"")
  1. S AUPNSEX=$P(VADM(5),U),GMPVA=1,GMPSC=VAEL(3),GMPAGTOR=VASV(2),GMPION=VASV(3)
  1. S X=$P($G(^DPT(DFN,.322)),U,10),GMPGULF=$S(X="Y":1,X="N":0,1:"")
  1. S GMPCV=0 I +$G(VASV(10)) S:DT'>$P($G(VASV(10,1)),U) GMPCV=1 ;CV
  1. S GMPSHD=+$G(VASV(14,1)) ;SHAD
  1. S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),GMPHNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"")
  1. S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),GMPMST=$S(X="Y":1,X="N":0,1:"")
  1. S GMPLVIEW("VIEW")=$S($P($G(^SC(+$G(LOC),0)),U,3)="C":"C",1:"S")
  1. S GMPCLIN="" I $G(LOC),GMPLVIEW("VIEW")="C" S GMPCLIN=+LOC_U_$P(^SC(+LOC,0),U)
  1. S X=$$PARAM,GMPARAM("VER")=+$P(X,U,2),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=+$P(X,U,5)
  1. S:+GMPROV=DUZ GMPLUSER=1 S GMPVAMC=+$G(DUZ(2)),GMPLIST(0)=0
  1. Q
  1. ;
  1. EDIT(DFN,LOC,GMPROV,GMPIFN) ; Interactive LMgr action to edit a problem
  1. N GMPARAM,GMPDFN,GMPVA,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST,GMPCV,GMPSHD
  1. N GMPLVIEW,GMPCLIN,GMPLJUMP,GMPQUIT,GMPLUSER,GMPLVAMC,AUPNSEX
  1. L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 Q
  1. D SETVARS,EN^VALM("GMPL EDIT PROBLEM")
  1. L -^AUPNPROB(GMPIFN,0)
  1. Q
  1. ;
  1. REMOVE(GMPIFN,GMPROV,TEXT,PLY) ; -- Remove problem GMPIFN
  1. N GMPVAMC,CHANGE
  1. S GMPVAMC=+$G(DUZ(2)),PLY=-1,PLY(0)=""
  1. I '$L($G(^AUPNPROB(GMPIFN,0))) S PLY(0)="Invalid problem" Q
  1. I '$D(^VA(200,+$G(GMPROV),0)) S PLY(0)="Invalid provider" Q
  1. I $L($G(TEXT)) S GMPFLD(10,"NEW",1)=TEXT D NEWNOTE^GMPLSAVE
  1. S CHANGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_U_$P($G(^AUPNPROB(GMPIFN,1)),U,2)_"^H^Deleted^"_+$G(GMPROV),$P(^AUPNPROB(GMPIFN,1),U,2)="H",PLY=GMPIFN
  1. D AUDIT^GMPLX(CHANGE,""),DTMOD^GMPLX(GMPIFN)
  1. Q
  1. ;
  1. PARAM() ; -- Returns parameter values from 125.99
  1. Q $G(^GMPL(125.99,1,0))
  1. ;
  1. VAF(DFN,SILENT) ; -- print PL VA Form chart copy
  1. ;
  1. N VA,VADM,VAERR,GMPDFN,GMPVAMC,X,GMPARAM,GMPRT,GMPQUIT,GMPLCURR
  1. Q:'$G(DFN) D DEM^VADPT S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")
  1. S GMPVAMC=+$G(DUZ(2)),GMPARAM("QUIET")=1
  1. S X=$G(^GMPL(125.99,1,0)),GMPARAM("VER")=+$P(X,U,2),GMPARAM("PRT")=+$P(X,U,3),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=$S($P(X,U,5)="R":1,1:0) K X
  1. D VAF^GMPLPRNT I '$G(SILENT) D Q:$G(GMPQUIT)
  1. . I GMPRT'>0 W !!,"No problems available." S GMPQUIT=1 Q
  1. . D DEVICE^GMPLPRNT Q:$G(GMPQUIT) D CLEAR^VALM1
  1. D PRT^GMPLPRNT
  1. Q
  1. SCTTEXT(GMPLCODE,GMPDT,GMPSYS) ; Get Preferred Text for SCT Code
  1. N %DT,GMPY,LEX,LEXY S GMPY="",GMPDT=$G(GMPDT,DT),GMPSYS=$G(GMPSYS,"SCT")
  1. S LEXY=$$CODE^LEXTRAN(GMPLCODE,GMPSYS,GMPDT)
  1. I '+LEXY G SCTTEXQ
  1. S GMPY=$G(LEX("P"))
  1. SCTTEXQ Q GMPY
  1. ICDDESC(GMPLCODE,GMPDT,GMPLCSYS) ; Get description for ICD Code
  1. N ICDD,GMPY,ICDY S GMPY="",GMPDT=$G(GMPDT,DT)
  1. S:'$G(GMPLCSYS) GMPLCSYS=$$SAB^ICDEX($P($$CODECS^ICDEX(GMPLCODE,80,GMPDT),U),GMPDT)
  1. S ICDY=$$ICDDESC^ICDXCODE(GMPLCSYS,GMPLCODE,GMPDT,.ICDD)
  1. I 'ICDY G ICDDESQ
  1. S GMPY=$G(ICDD(1))
  1. ICDDESQ Q GMPY