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

GMPLUTL.m

Go to the documentation of this file.
  1. GMPLUTL ; SLC/MKB/KER/TC -- PL Utilities ;03/30/2020
  1. ;;2.0;Problem List;**3,6,8,10,16,26,35,39,36,42,40,50,53**;Aug 25, 1994;Build 159
  1. ;
  1. ; External References
  1. ; DBIA 348 ^DPT(
  1. ; ICR 5699 $$ICDDATA^ICDXCODE
  1. ; DBIA 10006 ^VA(200
  1. ;
  1. ACTIVE(GMPDFN,GMPL) ; Returns list of Active Problems for a Patient
  1. ;
  1. ; GMPDFN Pointer to Patient
  1. ; GMPL Array in which the problems will be
  1. ; returned, passed by reference
  1. ;
  1. ; GMPL(#,0) Problem file (#9000011) IEN
  1. ; GMPL(#,1) Piece 1: Pointer to Problem (Lexicon file #757.01)
  1. ; 2: Provider Narrative
  1. ; NOTE: the provider narrative may be different
  1. ; from the Lexicon term in file 757.01
  1. ; GMPL(#,2) Piece 1: Pointer to ICD Diagnosis (file #80)
  1. ; 2: ICD-9/10 Code
  1. ; GMPL(#,3) Piece 1: Internal Date of Onset
  1. ; 2: External Date of Onset 00/00/00
  1. ; GMPL(#,4) Piece 1: Abbreviated Service Connection
  1. ; SC^Service Connected
  1. ; NSC^Not Service Connected
  1. ; null
  1. ; 2: Full text Service Connection
  1. ; GMPL(#,5) Piece 1: Abbreviated Exposure
  1. ; Full text Exposure
  1. ; AO^Agent Orange
  1. ; IR^Radiation
  1. ; EC^Evn Contaminants
  1. ; HNC^Head/Neck Cancer
  1. ; MST^Mil Sexual Trauma
  1. ; CV^Combat Vet
  1. ; SHD^SHAD
  1. ; null
  1. ;
  1. N IFN,CNT,SP,NUM,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL
  1. Q:$G(GMPDFN)'>0 S CNT=0,SP=""
  1. S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R"
  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 I,GMPL0,GMPL1,GMPL802,ICDC,GMPCSYS,GMPDT,ONSET
  1. . S IFN=+GMPLIST(NUM) Q:IFN'>0
  1. . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL802=$G(^(802)),CNT=CNT+1,GMPL(CNT,0)=IFN
  1. . S GMPDT=$S(+$P(GMPL802,U,1):$P(GMPL802,U,1),1:$P(GMPL0,U,8)),GMPCSYS=$S($P(GMPL802,U,2)]"":$P(GMPL802,U,2),1:$$SAB^ICDEX($$CSI^ICDEX(80,+GMPL0),GMPDT))
  1. . S ICDC=$P($$ICDDATA^ICDXCODE(GMPCSYS,+GMPL0,GMPDT,"I"),U,2)
  1. . S GMPL(CNT,1)=+GMPL1_U_$$PROBTEXT^GMPLX(IFN)
  1. . S GMPL(CNT,2)=+GMPL0_U_ICDC,ONSET=$P(GMPL0,U,13)
  1. . S GMPL(CNT,3)=$S(ONSET:ONSET_U_$$EXTDT^GMPLX(ONSET),1:"")
  1. . S GMPL(CNT,4)=$S(+$P(GMPL1,U,10):"SC^SERVICE-CONNECTED",$P(GMPL1,U,10)=0:"NSC^NOT SERVICE-CONNECTED",1:"")
  1. . F I=11,12,13,15,16,17,18 S:$P(GMPL1,U,I) SP=$S(I=11:"A",I=12:"I",I=13:"P",I=15:"H",I=16:"M",I=17:"C",1:"S")
  1. . S GMPL(CNT,5)=$S(SP="A":"AO^AGENT ORANGE",SP="I":"IR^RADIATION",SP="P":"EC^ENV CONTAMINANTS",SP="H":"HNC^HEAD AND/OR NECK CANCER",SP="M":"MST^MILIARY SEXUAL TRAUMA",SP="C":"CV^COMBAT VET",SP="S":"SHD^SHAD",1:"")
  1. S GMPL(0)=CNT
  1. Q
  1. ;
  1. CREATE(PL,PLY) ; Creates a new problem
  1. ;
  1. ; Input array, passed by reference
  1. ; Required
  1. ; PL("PATIENT") Pointer to Patient #2
  1. ; PL("NARRATIVE") Text as entered by provider
  1. ; PL("PROVIDER") Pointer to provider #200
  1. ; Optional
  1. ; PL("DIAGNOSIS") Pointer to ICD-9 #80
  1. ; PL("LEXICON") Pointer to Lexicon #757.01
  1. ; PL("STATUS") A = Active I = Inactive
  1. ; PL("ONSET") Internal Date of Onset
  1. ; PL("RECORDED") Internal Date Recorded
  1. ; PL("RESOLVED") Internal Date Problem was Resolved
  1. ; PL("COMMENT") Comment text, up to 60 characters
  1. ; PL("LOCATION") Pointer to Hospital Location
  1. ; PL("SC") Service Connected 1 = Yes 0 = No
  1. ; PL("AO") Agent Orange 1 = Yes 0 = No
  1. ; PL("IR") Radiation 1 = Yes 0 = No
  1. ; PL("EC") Env Contamination 1 = Yes 0 = No
  1. ; PL("HNC") Head/Neck Cancer 1 = Yes 0 = No
  1. ; PL("MST") Mil Sexual Trauma 1 = Yes 0 = No
  1. ; PL("CV") Combat Vet 1 = Yes 0 = No
  1. ; PL("SHD") Shipboard Hazard & Defense 1=Yes 0=No
  1. ; PL("DX_DATE_OF_INTEREST") For historical encounters (=Today's date) & all other encounters (=encounter date/time)
  1. ;
  1. ; Output, passed by reference
  1. ; PLY Equivalent of Fileman Y, DA
  1. ; PLY(0) Equivalent of Fileman Y(0)
  1. ;
  1. N GMPI,GMPQUIT,GMPVAMC,GMPVA,GMPFLD,GMPSC,GMPAGTOR,GMPION,GMPGULF
  1. N GMPHNC,GMPMST,GMPCV,GMPSHD,DA,GMPDFN,GMPROV
  1. K PLY S PLY=-1,PLY(0)=""
  1. S GMPVAMC=+$G(DUZ(2)),GMPVA=$S($G(DUZ("AG"))="V":1,1:0)
  1. I '$L($G(PL("NARRATIVE"))) S PLY(0)="Missing problem narrative" Q
  1. ;ICR #6953
  1. I $P($$PROVNARR^PXAPI(PL("NARRATIVE"),""),U,1)=-1 S PLY(0)="Invalid problem narrative" Q
  1. I '$D(^DPT(+$G(PL("PATIENT")),0)) S PLY(0)="Invalid patient" Q
  1. I '$D(^VA(200,+$G(PL("PROVIDER")),0)) S PLY(0)="Invalid provider" Q
  1. S GMPDFN=+PL("PATIENT"),(GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST,GMPCV,GMPSHD)=0
  1. S:'$L($G(PL("DX_DATE_OF_INTEREST"))) PL("DX_DATE_OF_INTEREST")=$$DT^XLFDT
  1. D:GMPVA VADPT^GMPLX1(GMPDFN)
  1. F GMPI="DIAGNOSI","LEXICON","DUPLICAT","LOCATION","STATUS" D @(GMPI_"^GMPLUTL1") Q:$D(GMPQUIT)
  1. Q:$D(GMPQUIT)
  1. F GMPI="ONSET","RESOLVED","RECORDED","SC","AO","IR","EC","HNC","MST","CV","SHD" D @(GMPI_"^GMPLUTL1") Q:$D(GMPQUIT)
  1. Q:$D(GMPQUIT)
  1. CR1 ; Ok to Create
  1. I $S(PL("LEXICON")=1:1,PL("LEXICON")="":1,$P(PL("LEXICON"),U,2)']"":1,1:0),(PL("NARRATIVE")["SNOMED CT") D FIXLEX(.PL)
  1. S GMPFLD(.01)=PL("DIAGNOSIS")_U_$S(PL("NARRATIVE")["(ICD-9-CM":$P($P(PL("NARRATIVE"),"ICD-9-CM ",2),")"),1:"")
  1. S GMPFLD(1.01)=PL("LEXICON")
  1. S GMPFLD(.05)=U_$E(PL("NARRATIVE"),1,80)
  1. S (GMPROV,GMPFLD(1.04),GMPFLD(1.05))=+PL("PROVIDER")
  1. S GMPFLD(1.06)=$$SERVICE^GMPLX1(+PL("PROVIDER"))
  1. S GMPFLD(.13)=PL("ONSET"),GMPFLD(1.09)=PL("RECORDED")
  1. S GMPFLD(1.02)=$S('$P(^GMPL(125.99,1,0),U,2):"P",$G(GMPLUSER):"P",1:"T")
  1. S GMPFLD(.12)=PL("STATUS"),GMPFLD(1.14)="",GMPFLD(1.07)=PL("RESOLVED")
  1. S GMPFLD(10,0)=0,GMPFLD(1.03)=$G(DUZ),GMPFLD(1.08)=PL("LOCATION")
  1. S:$L($G(PL("COMMENT"))) GMPFLD(10,"NEW",1)=$E(PL("COMMENT"),1,60)
  1. S GMPFLD(1.1)=PL("SC"),GMPFLD(1.11)=PL("AO"),GMPFLD(1.12)=PL("IR")
  1. S GMPFLD(1.13)=PL("EC"),GMPFLD(1.15)=$G(PL("HNC")),GMPFLD(1.16)=$G(PL("MST"))
  1. S GMPFLD(1.17)=$G(PL("CV")),GMPFLD(1.18)=$G(PL("SHD"))
  1. S GMPFLD(80201)=$G(PL("DX_DATE_OF_INTEREST"))
  1. D NEW^GMPLSAVE S PLY=DA
  1. CRQ ; Quit Create
  1. Q
  1. ;
  1. FIXLEX(PL) ; Fix Lexicon expression pointer value for SNOMED Concepts
  1. N SCT,LEXS,ICDS
  1. S SCT=+$P(PL("NARRATIVE"),"SNOMED CT ",2) I +SCT'>0 Q
  1. D EN^LEXCODE(SCT) I '$D(LEXS("SCT",1)) Q
  1. S PL("NARRATIVE")=$P(PL("NARRATIVE")," (SNOMED CT")
  1. S PL("LEXICON")=$P(LEXS("SCT",1),U)_U_PL("NARRATIVE")_" (SNOMED CT "_SCT_")"
  1. S ICDS=$$GETDX(SCT,$G(PL("DX_DATE_OF_INTEREST")))
  1. S:($L(ICDS,"/")>1)&(ICDS'=$P($G(PL("DIAGNOSIS")),U,2)) $P(PL("DIAGNOSIS"),U,2)=ICDS
  1. Q
  1. ;
  1. GETDX(CODE,GMPDT) ; Get ICD associated with SNOMED CT Code
  1. N LEX,ORI,ORY,GMPIMPDT,GMPMPDEF S GMPDT=$G(GMPDT,$$DT^XLFDT)
  1. S ORY=0,GMPIMPDT=$$IMPDATE^LEXU("10D")
  1. S GMPMPDEF=$S(GMPDT<GMPIMPDT:"SCT2ICD",1:"SCT210D")
  1. S ORY=$$GETASSN^LEXTRAN1(CODE,GMPMPDEF,GMPDT)
  1. I $S(+ORY'>0:1,+$P(ORY,U,2)'>0:1,+LEX'>0:1,1:0) S ORY=$S(GMPDT<GMPIMPDT:"799.9",1:"R69.") G GETDXX
  1. S (ORI,ORY)=0
  1. F S ORI=$O(LEX(ORI)) Q:+ORI'>0 D
  1. . N ICD
  1. . S ICD=$O(LEX(ORI,""))
  1. . I ICD]"" S ORY=$S(ORY'=0:ORY_"/",1:"")_ICD
  1. I ORY'["." S ORY=ORY_"."
  1. GETDXX Q ORY
  1. ;
  1. UPDATE(PL,PLY) ; Update a Problem/Create if Not Found
  1. ;
  1. ; Input array, passed by reference
  1. ; Required
  1. ; PL("PROBLEM") Pointer to Problem #9000011
  1. ; PL("PROVIDER") Pointer to provider #200
  1. ;
  1. ; Optional
  1. ; PL("NARRATIVE") Text as entered by provider
  1. ; PL("DIAGNOSIS") Pointer to ICD-9 #80
  1. ; PL("LEXICON") Pointer to Lexicon #757.01
  1. ; PL("STATUS") A = Active I = Inactive
  1. ; PL("ONSET") Internal Date of Onset
  1. ; PL("RECORDED") Internal Date Recorded
  1. ; PL("RESOLVED") Internal Date Problem was Resolved
  1. ; PL("COMMENT") Comment text, up to 60 characters
  1. ; PL("LOCATION") Pointer to Hospital Location
  1. ; PL("SC") Service Connected 1 = Yes 0 = No
  1. ; PL("AO") Agent Orange 1 = Yes 0 = No
  1. ; PL("IR") Radiation 1 = Yes 0 = No
  1. ; PL("EC") Env Contamination 1 = Yes 0 = No
  1. ; PL("HNC") Head/Neck Cancer 1 = Yes 0 = No
  1. ; PL("MST") Mil Sexual Trauma 1 = Yes 0 = No
  1. ; PL("CV") Combat Veteran 1 = Yes 0 = No
  1. ; PL("SHD") SHAD 1 = Yes 0 = No
  1. ; PL("SCTC") SNOMED CT Concept Code
  1. ; PL("SCTD") SNOMED CT Designation Code
  1. ; PL("CODEDT") Date of interest for the primary ICD Diagnosis
  1. ; PL("CODESYS") Coding system of the primary ICD Diagnosis
  1. ; PL("DX_DATE_OF_INTEREST") For historical encounters (=Today's date) & all other encounters (=encounter date/time)
  1. ;
  1. ; Output, passed by reference
  1. ; PLY Equivalent of Fileman Y, DA
  1. ; PLY(0) Equivalent of Fileman Y(0)
  1. ;
  1. N GMPORIG,GMPFLD,FLD,ITEMS,SUB,GMPI,DIFFRENT,GMPIFN,GMPVAMC,GMPVA,GMPROV,GMPQUIT,GMPDFN
  1. N GMPSC,GMPAGTOR,GMPION,GMPGULF
  1. S GMPVAMC=+$G(DUZ(2)),GMPVA=$S($G(DUZ("AG"))="V":1,1:0),PLY=-1,PLY(0)=""
  1. S GMPIFN=$G(PL("PROBLEM")) I GMPIFN="" D CREATE(.PL,.PLY) Q
  1. I '$D(^AUPNPROB(GMPIFN,0)) S PLY(0)="Invalid problem" Q
  1. I '$D(^VA(200,+$G(PL("PROVIDER")),0)) S PLY(0)="Invalid provider" Q
  1. S GMPROV=+$G(PL("PROVIDER")),GMPDFN=+$P(^AUPNPROB(GMPIFN,0),U,2)
  1. D GETFLDS^GMPLEDT3(GMPIFN) I '$D(GMPFLD) S PLY(0)="Invalid problem" Q
  1. I +$G(PL("PATIENT")),+PL("PATIENT")'=GMPDFN S PLY(0)="Patient does not match for this problem" Q
  1. I $L($G(PL("RECORDED"))) S PLY(0)="Date Recorded is not editable" Q
  1. S (GMPSC,GMPAGTOR,GMPION,GMPGULF)=0 D:GMPVA VADPT^GMPLX1(GMPDFN)
  1. S:'$L($G(PL("DX_DATE_OF_INTEREST"))) PL("DX_DATE_OF_INTEREST")=$$DT^XLFDT
  1. I '$L($G(PL("CODESYS"))),$L($G(PL("DIAGNOSIS"))) D
  1. . S PL("CODESYS")=$$SAB^ICDEX($$CSI^ICDEX(80,+PL("DIAGNOSIS")),PL("DX_DATE_OF_INTEREST"))
  1. S ITEMS="LEXICON^DIAGNOSIS^LOCATION^STATUS^ONSET^RESOLVED^SC^AO^IR^EC^HNC^MST^CV^SHD",FLD="1.01^.01^1.08^.12^.13^1.07^1.1^1.11^1.12^1.13^1.15^1.16^1.17^1.18"
  1. F GMPI=1:1 S SUB=$P(ITEMS,U,GMPI) Q:SUB="" D Q:$D(GMPQUIT)
  1. . I '$L($G(PL(SUB))) S PL(SUB)=$P(GMPFLD($P(FLD,U,GMPI)),U) Q
  1. . I SUB="STATUS",PL(SUB)="@" S GMPQUIT=1,PLY(0)="Cannot delete problem status" Q
  1. . I PL(SUB)'="@" D @($E(SUB,1,8)_"^GMPLUTL1") Q:$D(GMPQUIT)
  1. . S GMPFLD($P(FLD,U,GMPI))=$S(PL(SUB)="@":"",1:PL(SUB)),DIFFRENT=1
  1. Q:$D(GMPQUIT)
  1. I +GMPFLD(1.07),GMPFLD(1.07)<GMPFLD(.13) S PLY(0)="Date Resolved cannot be prior to Date of Onset" Q
  1. I +GMPFLD(1.09),GMPFLD(1.09)<GMPFLD(.13) S PLY(0)="Date Recorded cannot be prior to Date of Onset" Q
  1. I $P($G(PL("NARRATIVE")),U,1)=-1 S PLY(0)="Invalid Provider Narrative" Q
  1. S:$L($G(PL("NARRATIVE"))) GMPFLD(.05)=U_PL("NARRATIVE"),DIFFRENT=1
  1. S:$L($G(PL("COMMENT"))) GMPFLD(10,"NEW",1)=$E(PL("COMMENT"),1,60),DIFFRENT=1
  1. D:$D(DIFFRENT) EN^GMPLSAVE S PLY=GMPIFN,PLY(0)=""
  1. Q