GMPLUTL2 ; ISL/MKB,KER,JER,TC -- PL Utilities (OE/TIU) ;02/16/17 12:21
;;2.0;Problem List;**10,18,21,26,35,36,42,45,49**;Aug 25, 1994;Build 43
;
; External References
; DBIA 348 ^DPT( file #2
; ICR 5699 $$ICDDATA^ICDXCODE
; ICR 5747 $$SAB^ICDEX,$$CODECS^ICDEX,$$CSI^ICDEX
; DBIA 10040 ^SC( file #44
; DBIA 10060 ^VA(200,$$GET1^DIQ(200
; DBIA 2716 $$GETSTAT^DGMSTAPI
; DBIA 3457 $$GETCUR^DGNTAPI
; DBIA 10062 7^VADPT
; DBIA 10062 DEM^VADPT
; DBIA 10118 EN^VALM
; DBIA 10116 CLEAR^VALM1
; DBIA 10103 $$HTFM^XLFDT
;
LIST(GMPL,GMPDFN,GMPSTAT,GMPCOMM) ; Returns list of Problems for Patient
D LIST^GMPLUTL3
Q
;
DETAIL(IFN,GMPL) ; Returns Detailed Data for Problem
;
; Input IFN Pointer to Problem file #9000011
;
; Output GMPL Array, passed by reference
; GMPL("DATA NAME") = External Format of Value
;
; GMPL("DIAGNOSIS") ICD Code
; GMPL("ICDD") ICD Description
; GMPL("CSYS") Coding System (#80202) [ex: 10D (ICD-10) & ICD (ICD-9)]
; GMPL("DTINTEREST") Date of Interest (#80201)
; GMPL("PATIENT") Patient Name
; GMPL("MODIFIED") Date Last Modified
; GMPL("NARRATIVE") Provider Narrative
; GMPL("ENTERED") Date Entered ^ Entered by
; GMPL("STATUS") Status
; GMPL("PRIORITY") Priority Acute/Chronic
; GMPL("ONSET") Date of Onset
; GMPL("PROVIDER") Responsible Provider
; GMPL("RECORDED") Date Recorded ^ Recorded by
; GMPL("CONDITION") Patient Condition (#1.02)
; GMPL("RESOLVED") Date Resolved (#1.07)
; GMPL("CLINIC") Hospital Location
; GMPL("SERVICE") Service (#1.06)
; GMPL("FACILITY") Facility ID ^ Facility Name (#.06)
; GMPL("SC") Service Connected SC/NSC/""
; GMPL("SCTC") SNOMED-CT Concept Code
; GMPL("SCTD") SNOMED-CT Designation Code
; GMPL("SCTT") SNOMED-CT Preferred Text
; GMPL("VHATC") VHAT Concept Code
; GMPL("VHATD") VHAT Designation Code
; GMPL("VHATT") VHAT Preferred Text
;
; GMPL("ICD9MLTP") = #
; GMPL("ICD9MLTP",CNT) = ICD-9-CM/ICD-10-CM Code^ICD-9-CM/ICD-10-CM Description^ICD Coding System
;
; GMPL("EXPOSURE") = #
; GMPL("EXPOSURE",X)="AGENT ORANGE"
; GMPL("EXPOSURE",X)="RADIATION"
; GMPL("EXPOSURE",X)="ENV CONTAMINANTS"
; GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER"
; GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA"
; GMPL("EXPOSURE",X)="COMBAT VET"
; GMPL("EXPOSURE",X)="SHAD"
;
; GMPL("COMMENT") = #
; GMPL("COMMENT",CNT) = Date ^ Author ^ Text of Note
;
N GMPL0,GMPL1,GMPL800,GMPL802,GMPL803,GMPLP,X,I,FAC,CNT,NIFN,GMPLNTDT,GMPLATHR,GMPLTEXT Q:'$D(^AUPNPROB(IFN,0))
K ^TMP("GMPLCMT",$J)
S GMPLP=+($$PTR^GMPLUTL4)
S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),GMPL802=$G(^(802)),GMPL803=$G(^(803,0))
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")))
S GMPL("DIAGNOSIS")=$P($$ICDDATA^ICDXCODE(GMPL("CSYS"),+GMPL0,GMPL("DTINTEREST"),"I"),U,2)
S GMPL("FACILITY")=$$RESOLVE(IFN,".06","IE")
S GMPL("ICDD")=$$ICDDESC(GMPL("DIAGNOSIS"),GMPL("DTINTEREST"),GMPL("CSYS"))
S GMPL("PATIENT")=$P($G(^DPT(+$P(GMPL0,U,2),0)),U)
S GMPL("MODIFIED")=$$EXTDT^GMPLX($P(GMPL0,U,3))
S GMPL("NARRATIVE")=$$PROBTEXT^GMPLX(IFN)
S GMPL("ENTERED")=$$EXTDT^GMPLX($P(GMPL0,U,8))_U_$P($G(^VA(200,+$P(GMPL1,U,3),0)),U)
S X=$P(GMPL0,U,12),GMPL("STATUS")=$S(X="A":"ACTIVE",1:"INACTIVE")
S X=$S(X'="A":"",1:$P(GMPL1,U,14)),GMPL("PRIORITY")=$S(X="A":"ACUTE",X="C":"CHRONIC",1:"")
S GMPL("ONSET")=$$EXTDT^GMPLX($P(GMPL0,U,13))
S GMPL("CONDITION")=$$RESOLVE(IFN,"1.02","E")
S GMPL("PROVIDER")=$P($G(^VA(200,+$P(GMPL1,U,5),0)),U)
S GMPL("RECORDED")=$$EXTDT^GMPLX($P(GMPL1,U,9))_U_$P($G(^VA(200,+$P(GMPL1,U,4),0)),U)
S GMPL("RESOLVED")=$$EXTDT^GMPLX($P(GMPL1,U,7))
S GMPL("CLINIC")=$P($G(^SC(+$P(GMPL1,U,8),0)),U)
S GMPL("SERVICE")=$$RESOLVE(IFN,1.06,"E")
S GMPL("SCTC")=$P(GMPL800,U),GMPL("SCTD")=$P(GMPL800,U,2)
I $L($G(GMPL("SCTC"))) S GMPL("SCTT")=$P($$SCTTEXT(GMPL("SCTC"),$P(GMPL0,U,8),"SCT"),U)
S GMPL("VHATC")=$P(GMPL800,U,3),GMPL("VHATD")=$P(GMPL800,U,4)
I $L($G(GMPL("VHATC"))) S GMPL("VHATT")=$$SCTTEXT(GMPL("VHATC"),$P(GMPL0,U,8),"VHAT")
S GMPL("ICD9MLTP")=""
I $L($G(GMPL803))>0 D
. N DA,ICDDESC S (CNT,DA)=0,GMPL("ICD9MLTP")=0 F S DA=$O(^AUPNPROB(IFN,803,DA)) Q:'+DA D
. . S X=$G(^AUPNPROB(IFN,803,DA,0)),ICDDESC=$$ICDDESC($P(X,U),$P(X,U,3),$P(X,U,2))
. . S CNT=CNT+1,GMPL("ICD9MLTP",CNT)=$P(X,U)_U_$G(ICDDESC)_U_$P(X,U,2)
. S GMPL("ICD9MLTP")=CNT
S GMPL("SC")=$S($P(GMPL1,U,10):"YES",$P(GMPL1,U,10)=0:"NO",1:"UNKNOWN")
S GMPL("EXPOSURE")=0
I $P(GMPL1,U,11) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="AGENT ORANGE",GMPL("EXPOSURE")=X
I $P(GMPL1,U,12) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="RADIATION",GMPL("EXPOSURE")=X
I $P(GMPL1,U,13) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="ENV CONTAMINANTS",GMPL("EXPOSURE")=X
I $P(GMPL1,U,15) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER",GMPL("EXPOSURE")=X
I $P(GMPL1,U,16) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA",GMPL("EXPOSURE")=X
I $P(GMPL1,U,17) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="COMBAT VET",GMPL("EXPOSURE")=X
I $P(GMPL1,U,18)&(GMPLP'>0) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="SHAD",GMPL("EXPOSURE")=X
S (FAC,CNT)=0,GMPL("COMMENT")=0
F FAC=0:0 S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D
. F NIFN=0:0 S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D
. . S X=$G(^AUPNPROB(IFN,11,FAC,11,NIFN,0))
. . S GMPLNTDT=$P(X,U,5),GMPLATHR=$P(X,U,6),GMPLTEXT=$P(X,U,3)
. . S ^TMP("GMPLCMT",$J,NIFN)=$$EXTDT^GMPLX(GMPLNTDT)_U_$$GET1^DIQ(200,""_+GMPLATHR_",",.01)_U_GMPLTEXT
S NIFN=""
F S NIFN=$O(^TMP("GMPLCMT",$J,NIFN),-1) Q:NIFN="" D
. S CNT=CNT+1,GMPL("COMMENT",CNT)=^TMP("GMPLCMT",$J,NIFN)
K ^TMP("GMPLCMT",$J)
S GMPL("COMMENT")=CNT D AUDIT
Q
;
RESOLVE(IEN,FIELD,FORMAT) ; Call GET1^DIQ to resolve field values
; Input: IEN = Record #
; FIELD = Field # in PROBLEMS file #9000011
; FORMAT = "I"nternal, "E"xternal, or "IE" -> both
; Output: GMPLY = value as specified by format
N GMPLY
S IEN=IEN_","
S GMPLY=$$GET1^DIQ(9000011,IEN,FIELD,FORMAT)
S:FORMAT="IE" GMPLY=GMPLY_U_$$GET1^DIQ(9000011,IEN,FIELD,"E")
Q GMPLY
AUDIT ; 14 Sep 99 - MA - Add audit trail to OE Problem List.
; Called from DETAIL, requires IFN and sets GMPL("AUDIT")
N IDT,AIFN,X0,X1,FLD,CNT
S CNT=0,GMPL("AUDIT")=CNT
F IDT=0:0 S IDT=$O(^GMPL(125.8,"AD",IFN,IDT)) Q:IDT'>0 D
. F AIFN=0:0 S AIFN=$O(^GMPL(125.8,"AD",IFN,IDT,AIFN)) Q:AIFN'>0 D
.. S X0=$G(^GMPL(125.8,AIFN,0)),X1=$G(^(1)) Q:'$L(X0)
.. S FLD=$$FLDNAME(+$P(X0,U,2))
.. S CNT=CNT+1
.. S GMPL("AUDIT",CNT,0)=$P(X0,U,2)_U_FLD_U_$P(X0,U,3,8)
.. ; = pointer#^fld name^date mod^who mod^old^new^reason^prov
.. S:$L(X1) GMPL("AUDIT",CNT,1)=X1
S GMPL("AUDIT")=CNT
Q
;
FLDNAME(NUM) ; Returns field name for display
N NAME,NM1,NM2,I,J S J=0,NAME=""
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"
F I=1:1:$L(NM1,U) I +$P(NM1,U,I)=+NUM S J=I Q
G:J'>0 FNQ
S NM2="DIAGNOSIS^PROVIDER NARRATIVE^STATUS^DATE OF ONSET^PROBLEM^CONDITION^RECORDING PROVIDER^RESPONSIBLE PROVIDER"
S NM2=NM2_"^SERVICE^DATE RESOLVED^CLINIC^DATE RECORDED^SERVICE CONNECTED^AGENT ORANGE EXP^RADIATION EXP^ENV CONTAMINANTS EXP"
S NM2=NM2_"^IMMEDIACY^HEAD & NECK CANCER^MIL SEX TRAUMA^COMBAT VET^SHIPBOARD HAZARD EXP^SNOMED CT CONCEPT^SNOMED CT DESIGNATION"
S NM2=NM2_"^VHAT CONCEPT^VHAT DESIGNATION^SNOMED CT/ICD MAP STATUS^SECONDARY DIAGNOSIS^NOTE"
S NAME=$P(NM2,U,J)
FNQ Q NAME
;
ADD(DFN,LOC,GMPROV) ; -- Interactive LMgr action to add new problem
N X,Y,GMPDFN,GMPVA,GMPVAMC,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST,GMPCV,GMPSHD
N GMPARAM,GMPLVIEW,GMPLUSER,GMPCLIN,GMPLSLST,GMPQUIT,VALMCC,GMPSAVED,GMPCLPAR
Q:'DFN Q:'LOC D SETVARS
S GMPLSLST=$$GET^XPAR(DUZ_";VA(200,","ORQQPL SELECTION LIST",1),VALMCC=0
I +GMPCLIN S GMPCLPAR=$$GET^XPAR(+GMPCLIN_";SC(","ORQQPL SELECTION LIST",1)
I 'GMPLSLST,+GMPCLPAR S GMPLSLST=GMPCLPAR
I GMPLSLST D Q
. S $P(GMPLSLST,U,2)=$P($G(^GMPL(125,+GMPLSLST,0)),U)
. D EN^VALM("GMPL LIST MENU")
F D ADD^GMPL1 Q:$D(GMPQUIT) K DUOUT,DTOUT,GMPSAVED W !!,">>> Please enter another problem, or press <return> to exit."
Q
;
SETVARS ; -- Define GMP* variables used in ADD and EDIT
N VA,VADM,VAEL,VASV,X
Q:'DFN D DEM^VADPT,7^VADPT
S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")_$S(VADM(6):U_+VADM(6),1:"")
S AUPNSEX=$P(VADM(5),U),GMPVA=1,GMPSC=VAEL(3),GMPAGTOR=VASV(2),GMPION=VASV(3)
S X=$P($G(^DPT(DFN,.322)),U,10),GMPGULF=$S(X="Y":1,X="N":0,1:"")
S GMPCV=0 I +$G(VASV(10)) S:DT'>$P($G(VASV(10,1)),U) GMPCV=1 ;CV
S GMPSHD=+$G(VASV(14,1)) ;SHAD
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:"")
S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),GMPMST=$S(X="Y":1,X="N":0,1:"")
S GMPLVIEW("VIEW")=$S($P($G(^SC(+$G(LOC),0)),U,3)="C":"C",1:"S")
S GMPCLIN="" I $G(LOC),GMPLVIEW("VIEW")="C" S GMPCLIN=+LOC_U_$P(^SC(+LOC,0),U)
S X=$$PARAM,GMPARAM("VER")=+$P(X,U,2),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=+$P(X,U,5)
S:+GMPROV=DUZ GMPLUSER=1 S GMPVAMC=+$G(DUZ(2)),GMPLIST(0)=0
Q
;
EDIT(DFN,LOC,GMPROV,GMPIFN) ; Interactive LMgr action to edit a problem
N GMPARAM,GMPDFN,GMPVA,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST,GMPCV,GMPSHD
N GMPLVIEW,GMPCLIN,GMPLJUMP,GMPQUIT,GMPLUSER,GMPLVAMC,AUPNSEX
L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 Q
D SETVARS,EN^VALM("GMPL EDIT PROBLEM")
L -^AUPNPROB(GMPIFN,0)
Q
;
REMOVE(GMPIFN,GMPROV,TEXT,PLY) ; -- Remove problem GMPIFN
N GMPVAMC,CHANGE
S GMPVAMC=+$G(DUZ(2)),PLY=-1,PLY(0)=""
I '$L($G(^AUPNPROB(GMPIFN,0))) S PLY(0)="Invalid problem" Q
I '$D(^VA(200,+$G(GMPROV),0)) S PLY(0)="Invalid provider" Q
I $L($G(TEXT)) S GMPFLD(10,"NEW",1)=TEXT D NEWNOTE^GMPLSAVE
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
D AUDIT^GMPLX(CHANGE,""),DTMOD^GMPLX(GMPIFN)
Q
;
PARAM() ; -- Returns parameter values from 125.99
Q $G(^GMPL(125.99,1,0))
;
VAF(DFN,SILENT) ; -- print PL VA Form chart copy
;
N VA,VADM,VAERR,GMPDFN,GMPVAMC,X,GMPARAM,GMPRT,GMPQUIT,GMPLCURR
Q:'$G(DFN) D DEM^VADPT S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")
S GMPVAMC=+$G(DUZ(2)),GMPARAM("QUIET")=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
D VAF^GMPLPRNT I '$G(SILENT) D Q:$G(GMPQUIT)
. I GMPRT'>0 W !!,"No problems available." S GMPQUIT=1 Q
. D DEVICE^GMPLPRNT Q:$G(GMPQUIT) D CLEAR^VALM1
D PRT^GMPLPRNT
Q
SCTTEXT(GMPLCODE,GMPDT,GMPSYS) ; Get Preferred Text for SCT Code
N %DT,GMPY,LEX,LEXY S GMPY="",GMPDT=$G(GMPDT,DT),GMPSYS=$G(GMPSYS,"SCT")
S LEXY=$$CODE^LEXTRAN(GMPLCODE,GMPSYS,GMPDT)
I '+LEXY G SCTTEXQ
S GMPY=$G(LEX("P"))
SCTTEXQ Q GMPY
ICDDESC(GMPLCODE,GMPDT,GMPLCSYS) ; Get description for ICD Code
N ICDD,GMPY,ICDY S GMPY="",GMPDT=$G(GMPDT,DT)
S:'$G(GMPLCSYS) GMPLCSYS=$$SAB^ICDEX($P($$CODECS^ICDEX(GMPLCODE,80,GMPDT),U),GMPDT)
S ICDY=$$ICDDESC^ICDXCODE(GMPLCSYS,GMPLCODE,GMPDT,.ICDD)
I 'ICDY G ICDDESQ
S GMPY=$G(ICDD(1))
ICDDESQ Q GMPY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLUTL2 11801 printed Apr 09, 2024@21:32:39 Page 2
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
+2 ;
+3 ; External References
+4 ; DBIA 348 ^DPT( file #2
+5 ; ICR 5699 $$ICDDATA^ICDXCODE
+6 ; ICR 5747 $$SAB^ICDEX,$$CODECS^ICDEX,$$CSI^ICDEX
+7 ; DBIA 10040 ^SC( file #44
+8 ; DBIA 10060 ^VA(200,$$GET1^DIQ(200
+9 ; DBIA 2716 $$GETSTAT^DGMSTAPI
+10 ; DBIA 3457 $$GETCUR^DGNTAPI
+11 ; DBIA 10062 7^VADPT
+12 ; DBIA 10062 DEM^VADPT
+13 ; DBIA 10118 EN^VALM
+14 ; DBIA 10116 CLEAR^VALM1
+15 ; DBIA 10103 $$HTFM^XLFDT
+16 ;
LIST(GMPL,GMPDFN,GMPSTAT,GMPCOMM) ; Returns list of Problems for Patient
+1 DO LIST^GMPLUTL3
+2 QUIT
+3 ;
DETAIL(IFN,GMPL) ; Returns Detailed Data for Problem
+1 ;
+2 ; Input IFN Pointer to Problem file #9000011
+3 ;
+4 ; Output GMPL Array, passed by reference
+5 ; GMPL("DATA NAME") = External Format of Value
+6 ;
+7 ; GMPL("DIAGNOSIS") ICD Code
+8 ; GMPL("ICDD") ICD Description
+9 ; GMPL("CSYS") Coding System (#80202) [ex: 10D (ICD-10) & ICD (ICD-9)]
+10 ; GMPL("DTINTEREST") Date of Interest (#80201)
+11 ; GMPL("PATIENT") Patient Name
+12 ; GMPL("MODIFIED") Date Last Modified
+13 ; GMPL("NARRATIVE") Provider Narrative
+14 ; GMPL("ENTERED") Date Entered ^ Entered by
+15 ; GMPL("STATUS") Status
+16 ; GMPL("PRIORITY") Priority Acute/Chronic
+17 ; GMPL("ONSET") Date of Onset
+18 ; GMPL("PROVIDER") Responsible Provider
+19 ; GMPL("RECORDED") Date Recorded ^ Recorded by
+20 ; GMPL("CONDITION") Patient Condition (#1.02)
+21 ; GMPL("RESOLVED") Date Resolved (#1.07)
+22 ; GMPL("CLINIC") Hospital Location
+23 ; GMPL("SERVICE") Service (#1.06)
+24 ; GMPL("FACILITY") Facility ID ^ Facility Name (#.06)
+25 ; GMPL("SC") Service Connected SC/NSC/""
+26 ; GMPL("SCTC") SNOMED-CT Concept Code
+27 ; GMPL("SCTD") SNOMED-CT Designation Code
+28 ; GMPL("SCTT") SNOMED-CT Preferred Text
+29 ; GMPL("VHATC") VHAT Concept Code
+30 ; GMPL("VHATD") VHAT Designation Code
+31 ; GMPL("VHATT") VHAT Preferred Text
+32 ;
+33 ; GMPL("ICD9MLTP") = #
+34 ; GMPL("ICD9MLTP",CNT) = ICD-9-CM/ICD-10-CM Code^ICD-9-CM/ICD-10-CM Description^ICD Coding System
+35 ;
+36 ; GMPL("EXPOSURE") = #
+37 ; GMPL("EXPOSURE",X)="AGENT ORANGE"
+38 ; GMPL("EXPOSURE",X)="RADIATION"
+39 ; GMPL("EXPOSURE",X)="ENV CONTAMINANTS"
+40 ; GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER"
+41 ; GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA"
+42 ; GMPL("EXPOSURE",X)="COMBAT VET"
+43 ; GMPL("EXPOSURE",X)="SHAD"
+44 ;
+45 ; GMPL("COMMENT") = #
+46 ; GMPL("COMMENT",CNT) = Date ^ Author ^ Text of Note
+47 ;
+48 NEW GMPL0,GMPL1,GMPL800,GMPL802,GMPL803,GMPLP,X,I,FAC,CNT,NIFN,GMPLNTDT,GMPLATHR,GMPLTEXT
if '$DATA(^AUPNPROB(IFN,0))
QUIT
+49 KILL ^TMP("GMPLCMT",$JOB)
+50 SET GMPLP=+($$PTR^GMPLUTL4)
+51 SET GMPL0=$GET(^AUPNPROB(IFN,0))
SET GMPL1=$GET(^(1))
SET GMPL800=$GET(^(800))
SET GMPL802=$GET(^(802))
SET GMPL803=$GET(^(803,0))
+52 SET GMPL("DTINTEREST")=$SELECT(+$PIECE(GMPL802,U,1):$PIECE(GMPL802,U,1),1:$PIECE(GMPL0,U,8))
SET GMPL("CSYS")=$SELECT($PIECE(GMPL802,U,2)]"":$PIECE(GMPL802,U,2),1:$$SAB^ICDEX($$CSI^ICDEX(80,+GMPL0),GMPL("DTINTEREST")))
+53 SET GMPL("DIAGNOSIS")=$PIECE($$ICDDATA^ICDXCODE(GMPL("CSYS"),+GMPL0,GMPL("DTINTEREST"),"I"),U,2)
+54 SET GMPL("FACILITY")=$$RESOLVE(IFN,".06","IE")
+55 SET GMPL("ICDD")=$$ICDDESC(GMPL("DIAGNOSIS"),GMPL("DTINTEREST"),GMPL("CSYS"))
+56 SET GMPL("PATIENT")=$PIECE($GET(^DPT(+$PIECE(GMPL0,U,2),0)),U)
+57 SET GMPL("MODIFIED")=$$EXTDT^GMPLX($PIECE(GMPL0,U,3))
+58 SET GMPL("NARRATIVE")=$$PROBTEXT^GMPLX(IFN)
+59 SET GMPL("ENTERED")=$$EXTDT^GMPLX($PIECE(GMPL0,U,8))_U_$PIECE($GET(^VA(200,+$PIECE(GMPL1,U,3),0)),U)
+60 SET X=$PIECE(GMPL0,U,12)
SET GMPL("STATUS")=$SELECT(X="A":"ACTIVE",1:"INACTIVE")
+61 SET X=$SELECT(X'="A":"",1:$PIECE(GMPL1,U,14))
SET GMPL("PRIORITY")=$SELECT(X="A":"ACUTE",X="C":"CHRONIC",1:"")
+62 SET GMPL("ONSET")=$$EXTDT^GMPLX($PIECE(GMPL0,U,13))
+63 SET GMPL("CONDITION")=$$RESOLVE(IFN,"1.02","E")
+64 SET GMPL("PROVIDER")=$PIECE($GET(^VA(200,+$PIECE(GMPL1,U,5),0)),U)
+65 SET GMPL("RECORDED")=$$EXTDT^GMPLX($PIECE(GMPL1,U,9))_U_$PIECE($GET(^VA(200,+$PIECE(GMPL1,U,4),0)),U)
+66 SET GMPL("RESOLVED")=$$EXTDT^GMPLX($PIECE(GMPL1,U,7))
+67 SET GMPL("CLINIC")=$PIECE($GET(^SC(+$PIECE(GMPL1,U,8),0)),U)
+68 SET GMPL("SERVICE")=$$RESOLVE(IFN,1.06,"E")
+69 SET GMPL("SCTC")=$PIECE(GMPL800,U)
SET GMPL("SCTD")=$PIECE(GMPL800,U,2)
+70 IF $LENGTH($GET(GMPL("SCTC")))
SET GMPL("SCTT")=$PIECE($$SCTTEXT(GMPL("SCTC"),$PIECE(GMPL0,U,8),"SCT"),U)
+71 SET GMPL("VHATC")=$PIECE(GMPL800,U,3)
SET GMPL("VHATD")=$PIECE(GMPL800,U,4)
+72 IF $LENGTH($GET(GMPL("VHATC")))
SET GMPL("VHATT")=$$SCTTEXT(GMPL("VHATC"),$PIECE(GMPL0,U,8),"VHAT")
+73 SET GMPL("ICD9MLTP")=""
+74 IF $LENGTH($GET(GMPL803))>0
Begin DoDot:1
+75 NEW DA,ICDDESC
SET (CNT,DA)=0
SET GMPL("ICD9MLTP")=0
FOR
SET DA=$ORDER(^AUPNPROB(IFN,803,DA))
if '+DA
QUIT
Begin DoDot:2
+76 SET X=$GET(^AUPNPROB(IFN,803,DA,0))
SET ICDDESC=$$ICDDESC($PIECE(X,U),$PIECE(X,U,3),$PIECE(X,U,2))
+77 SET CNT=CNT+1
SET GMPL("ICD9MLTP",CNT)=$PIECE(X,U)_U_$GET(ICDDESC)_U_$PIECE(X,U,2)
End DoDot:2
+78 SET GMPL("ICD9MLTP")=CNT
End DoDot:1
+79 SET GMPL("SC")=$SELECT($PIECE(GMPL1,U,10):"YES",$PIECE(GMPL1,U,10)=0:"NO",1:"UNKNOWN")
+80 SET GMPL("EXPOSURE")=0
+81 IF $PIECE(GMPL1,U,11)
SET X=GMPL("EXPOSURE")+1
SET GMPL("EXPOSURE",X)="AGENT ORANGE"
SET GMPL("EXPOSURE")=X
+82 IF $PIECE(GMPL1,U,12)
SET X=GMPL("EXPOSURE")+1
SET GMPL("EXPOSURE",X)="RADIATION"
SET GMPL("EXPOSURE")=X
+83 IF $PIECE(GMPL1,U,13)
SET X=GMPL("EXPOSURE")+1
SET GMPL("EXPOSURE",X)="ENV CONTAMINANTS"
SET GMPL("EXPOSURE")=X
+84 IF $PIECE(GMPL1,U,15)
SET X=GMPL("EXPOSURE")+1
SET GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER"
SET GMPL("EXPOSURE")=X
+85 IF $PIECE(GMPL1,U,16)
SET X=GMPL("EXPOSURE")+1
SET GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA"
SET GMPL("EXPOSURE")=X
+86 IF $PIECE(GMPL1,U,17)
SET X=GMPL("EXPOSURE")+1
SET GMPL("EXPOSURE",X)="COMBAT VET"
SET GMPL("EXPOSURE")=X
+87 IF $PIECE(GMPL1,U,18)&(GMPLP'>0)
SET X=GMPL("EXPOSURE")+1
SET GMPL("EXPOSURE",X)="SHAD"
SET GMPL("EXPOSURE")=X
+88 SET (FAC,CNT)=0
SET GMPL("COMMENT")=0
+89 FOR FAC=0:0
SET FAC=$ORDER(^AUPNPROB(IFN,11,FAC))
if +FAC'>0
QUIT
Begin DoDot:1
+90 FOR NIFN=0:0
SET NIFN=$ORDER(^AUPNPROB(IFN,11,FAC,11,NIFN))
if NIFN'>0
QUIT
Begin DoDot:2
+91 SET X=$GET(^AUPNPROB(IFN,11,FAC,11,NIFN,0))
+92 SET GMPLNTDT=$PIECE(X,U,5)
SET GMPLATHR=$PIECE(X,U,6)
SET GMPLTEXT=$PIECE(X,U,3)
+93 SET ^TMP("GMPLCMT",$JOB,NIFN)=$$EXTDT^GMPLX(GMPLNTDT)_U_$$GET1^DIQ(200,""_+GMPLATHR_",",.01)_U_GMPLTEXT
End DoDot:2
End DoDot:1
+94 SET NIFN=""
+95 FOR
SET NIFN=$ORDER(^TMP("GMPLCMT",$JOB,NIFN),-1)
if NIFN=""
QUIT
Begin DoDot:1
+96 SET CNT=CNT+1
SET GMPL("COMMENT",CNT)=^TMP("GMPLCMT",$JOB,NIFN)
End DoDot:1
+97 KILL ^TMP("GMPLCMT",$JOB)
+98 SET GMPL("COMMENT")=CNT
DO AUDIT
+99 QUIT
+100 ;
RESOLVE(IEN,FIELD,FORMAT) ; Call GET1^DIQ to resolve field values
+1 ; Input: IEN = Record #
+2 ; FIELD = Field # in PROBLEMS file #9000011
+3 ; FORMAT = "I"nternal, "E"xternal, or "IE" -> both
+4 ; Output: GMPLY = value as specified by format
+5 NEW GMPLY
+6 SET IEN=IEN_","
+7 SET GMPLY=$$GET1^DIQ(9000011,IEN,FIELD,FORMAT)
+8 if FORMAT="IE"
SET GMPLY=GMPLY_U_$$GET1^DIQ(9000011,IEN,FIELD,"E")
+9 QUIT GMPLY
AUDIT ; 14 Sep 99 - MA - Add audit trail to OE Problem List.
+1 ; Called from DETAIL, requires IFN and sets GMPL("AUDIT")
+2 NEW IDT,AIFN,X0,X1,FLD,CNT
+3 SET CNT=0
SET GMPL("AUDIT")=CNT
+4 FOR IDT=0:0
SET IDT=$ORDER(^GMPL(125.8,"AD",IFN,IDT))
if IDT'>0
QUIT
Begin DoDot:1
+5 FOR AIFN=0:0
SET AIFN=$ORDER(^GMPL(125.8,"AD",IFN,IDT,AIFN))
if AIFN'>0
QUIT
Begin DoDot:2
+6 SET X0=$GET(^GMPL(125.8,AIFN,0))
SET X1=$GET(^(1))
if '$LENGTH(X0)
QUIT
+7 SET FLD=$$FLDNAME(+$PIECE(X0,U,2))
+8 SET CNT=CNT+1
+9 SET GMPL("AUDIT",CNT,0)=$PIECE(X0,U,2)_U_FLD_U_$PIECE(X0,U,3,8)
+10 ; = pointer#^fld name^date mod^who mod^old^new^reason^prov
+11 if $LENGTH(X1)
SET GMPL("AUDIT",CNT,1)=X1
End DoDot:2
End DoDot:1
+12 SET GMPL("AUDIT")=CNT
+13 QUIT
+14 ;
FLDNAME(NUM) ; Returns field name for display
+1 NEW NAME,NM1,NM2,I,J
SET J=0
SET NAME=""
+2 SET 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"
+3 FOR I=1:1:$LENGTH(NM1,U)
IF +$PIECE(NM1,U,I)=+NUM
SET J=I
QUIT
+4 if J'>0
GOTO FNQ
+5 SET NM2="DIAGNOSIS^PROVIDER NARRATIVE^STATUS^DATE OF ONSET^PROBLEM^CONDITION^RECORDING PROVIDER^RESPONSIBLE PROVIDER"
+6 SET NM2=NM2_"^SERVICE^DATE RESOLVED^CLINIC^DATE RECORDED^SERVICE CONNECTED^AGENT ORANGE EXP^RADIATION EXP^ENV CONTAMINANTS EXP"
+7 SET NM2=NM2_"^IMMEDIACY^HEAD & NECK CANCER^MIL SEX TRAUMA^COMBAT VET^SHIPBOARD HAZARD EXP^SNOMED CT CONCEPT^SNOMED CT DESIGNATION"
+8 SET NM2=NM2_"^VHAT CONCEPT^VHAT DESIGNATION^SNOMED CT/ICD MAP STATUS^SECONDARY DIAGNOSIS^NOTE"
+9 SET NAME=$PIECE(NM2,U,J)
FNQ QUIT NAME
+1 ;
ADD(DFN,LOC,GMPROV) ; -- Interactive LMgr action to add new problem
+1 NEW X,Y,GMPDFN,GMPVA,GMPVAMC,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST,GMPCV,GMPSHD
+2 NEW GMPARAM,GMPLVIEW,GMPLUSER,GMPCLIN,GMPLSLST,GMPQUIT,VALMCC,GMPSAVED,GMPCLPAR
+3 if 'DFN
QUIT
if 'LOC
QUIT
DO SETVARS
+4 SET GMPLSLST=$$GET^XPAR(DUZ_";VA(200,","ORQQPL SELECTION LIST",1)
SET VALMCC=0
+5 IF +GMPCLIN
SET GMPCLPAR=$$GET^XPAR(+GMPCLIN_";SC(","ORQQPL SELECTION LIST",1)
+6 IF 'GMPLSLST
IF +GMPCLPAR
SET GMPLSLST=GMPCLPAR
+7 IF GMPLSLST
Begin DoDot:1
+8 SET $PIECE(GMPLSLST,U,2)=$PIECE($GET(^GMPL(125,+GMPLSLST,0)),U)
+9 DO EN^VALM("GMPL LIST MENU")
End DoDot:1
QUIT
+10 FOR
DO ADD^GMPL1
if $DATA(GMPQUIT)
QUIT
KILL DUOUT,DTOUT,GMPSAVED
WRITE !!,">>> Please enter another problem, or press <return> to exit."
+11 QUIT
+12 ;
SETVARS ; -- Define GMP* variables used in ADD and EDIT
+1 NEW VA,VADM,VAEL,VASV,X
+2 if 'DFN
QUIT
DO DEM^VADPT
DO 7^VADPT
+3 SET GMPDFN=DFN_U_VADM(1)_U_$EXTRACT(VADM(1))_VA("BID")_$SELECT(VADM(6):U_+VADM(6),1:"")
+4 SET AUPNSEX=$PIECE(VADM(5),U)
SET GMPVA=1
SET GMPSC=VAEL(3)
SET GMPAGTOR=VASV(2)
SET GMPION=VASV(3)
+5 SET X=$PIECE($GET(^DPT(DFN,.322)),U,10)
SET GMPGULF=$SELECT(X="Y":1,X="N":0,1:"")
+6 ;CV
SET GMPCV=0
IF +$GET(VASV(10))
if DT'>$PIECE($GET(VASV(10,1)),U)
SET GMPCV=1
+7 ;SHAD
SET GMPSHD=+$GET(VASV(14,1))
+8 SET X=$$GETCUR^DGNTAPI(DFN,"HNC")
SET X=+($GET(HNC("STAT")))
SET GMPHNC=$SELECT(X=4:1,X=5:1,X=1:0,X=6:0,1:"")
+9 SET X=$PIECE($$GETSTAT^DGMSTAPI(DFN),"^",2)
SET GMPMST=$SELECT(X="Y":1,X="N":0,1:"")
+10 SET GMPLVIEW("VIEW")=$SELECT($PIECE($GET(^SC(+$GET(LOC),0)),U,3)="C":"C",1:"S")
+11 SET GMPCLIN=""
IF $GET(LOC)
IF GMPLVIEW("VIEW")="C"
SET GMPCLIN=+LOC_U_$PIECE(^SC(+LOC,0),U)
+12 SET X=$$PARAM
SET GMPARAM("VER")=+$PIECE(X,U,2)
SET GMPARAM("CLU")=+$PIECE(X,U,4)
SET GMPARAM("REV")=+$PIECE(X,U,5)
+13 if +GMPROV=DUZ
SET GMPLUSER=1
SET GMPVAMC=+$GET(DUZ(2))
SET GMPLIST(0)=0
+14 QUIT
+15 ;
EDIT(DFN,LOC,GMPROV,GMPIFN) ; Interactive LMgr action to edit a problem
+1 NEW GMPARAM,GMPDFN,GMPVA,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST,GMPCV,GMPSHD
+2 NEW GMPLVIEW,GMPCLIN,GMPLJUMP,GMPQUIT,GMPLUSER,GMPLVAMC,AUPNSEX
+3 LOCK +^AUPNPROB(GMPIFN,0):1
IF '$TEST
WRITE $CHAR(7),!!,$$LOCKED^GMPLX,!
HANG 2
QUIT
+4 DO SETVARS
DO EN^VALM("GMPL EDIT PROBLEM")
+5 LOCK -^AUPNPROB(GMPIFN,0)
+6 QUIT
+7 ;
REMOVE(GMPIFN,GMPROV,TEXT,PLY) ; -- Remove problem GMPIFN
+1 NEW GMPVAMC,CHANGE
+2 SET GMPVAMC=+$GET(DUZ(2))
SET PLY=-1
SET PLY(0)=""
+3 IF '$LENGTH($GET(^AUPNPROB(GMPIFN,0)))
SET PLY(0)="Invalid problem"
QUIT
+4 IF '$DATA(^VA(200,+$GET(GMPROV),0))
SET PLY(0)="Invalid provider"
QUIT
+5 IF $LENGTH($GET(TEXT))
SET GMPFLD(10,"NEW",1)=TEXT
DO NEWNOTE^GMPLSAVE
+6 SET CHANGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($HOROLOG)_U_DUZ_U_$PIECE($GET(^AUPNPROB(GMPIFN,1)),U,2)_"^H^Deleted^"_+$GET(GMPROV)
SET $PIECE(^AUPNPROB(GMPIFN,1),U,2)="H"
SET PLY=GMPIFN
+7 DO AUDIT^GMPLX(CHANGE,"")
DO DTMOD^GMPLX(GMPIFN)
+8 QUIT
+9 ;
PARAM() ; -- Returns parameter values from 125.99
+1 QUIT $GET(^GMPL(125.99,1,0))
+2 ;
VAF(DFN,SILENT) ; -- print PL VA Form chart copy
+1 ;
+2 NEW VA,VADM,VAERR,GMPDFN,GMPVAMC,X,GMPARAM,GMPRT,GMPQUIT,GMPLCURR
+3 if '$GET(DFN)
QUIT
DO DEM^VADPT
SET GMPDFN=DFN_U_VADM(1)_U_$EXTRACT(VADM(1))_VA("BID")
+4 SET GMPVAMC=+$GET(DUZ(2))
SET GMPARAM("QUIET")=1
+5 SET X=$GET(^GMPL(125.99,1,0))
SET GMPARAM("VER")=+$PIECE(X,U,2)
SET GMPARAM("PRT")=+$PIECE(X,U,3)
SET GMPARAM("CLU")=+$PIECE(X,U,4)
SET GMPARAM("REV")=$SELECT($PIECE(X,U,5)="R":1,1:0)
KILL X
+6 DO VAF^GMPLPRNT
IF '$GET(SILENT)
Begin DoDot:1
+7 IF GMPRT'>0
WRITE !!,"No problems available."
SET GMPQUIT=1
QUIT
+8 DO DEVICE^GMPLPRNT
if $GET(GMPQUIT)
QUIT
DO CLEAR^VALM1
End DoDot:1
if $GET(GMPQUIT)
QUIT
+9 DO PRT^GMPLPRNT
+10 QUIT
SCTTEXT(GMPLCODE,GMPDT,GMPSYS) ; Get Preferred Text for SCT Code
+1 NEW %DT,GMPY,LEX,LEXY
SET GMPY=""
SET GMPDT=$GET(GMPDT,DT)
SET GMPSYS=$GET(GMPSYS,"SCT")
+2 SET LEXY=$$CODE^LEXTRAN(GMPLCODE,GMPSYS,GMPDT)
+3 IF '+LEXY
GOTO SCTTEXQ
+4 SET GMPY=$GET(LEX("P"))
SCTTEXQ QUIT GMPY
ICDDESC(GMPLCODE,GMPDT,GMPLCSYS) ; Get description for ICD Code
+1 NEW ICDD,GMPY,ICDY
SET GMPY=""
SET GMPDT=$GET(GMPDT,DT)
+2 if '$GET(GMPLCSYS)
SET GMPLCSYS=$$SAB^ICDEX($PIECE($$CODECS^ICDEX(GMPLCODE,80,GMPDT),U),GMPDT)
+3 SET ICDY=$$ICDDESC^ICDXCODE(GMPLCSYS,GMPLCODE,GMPDT,.ICDD)
+4 IF 'ICDY
GOTO ICDDESQ
+5 SET GMPY=$GET(ICDD(1))
ICDDESQ QUIT GMPY
