- 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 Jan 18, 2025@03:31: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