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

GMPLUTL3.m

Go to the documentation of this file.
  1. GMPLUTL3 ; SLC/JST/JVS/TC -- PL Utilities (CIRN) ;08/22/12 08:50
  1. ;;2.0;Problem List;**14,15,19,25,26,36,42**;Aug 25, 1994;Build 46
  1. ;
  1. ; External References
  1. ; DBIA 5699 $$ICDDATA^ICDXCODE
  1. ;
  1. ; This routine is primarily called by CIRN for use
  1. ; in HL7 (RGHOPL), and Historical Load (RGHOPLB),
  1. ; record creation.
  1. ;
  1. ; NOTE: This routine DOES NOT NEW the variables
  1. ; that are set below.
  1. ;
  1. CALL0(GMPLZ) ; Call 0 - Get Node 0
  1. N GMPLCOND I $P($G(^AUPNPROB(GMPLZ,1)),"^",2)="H" S GMPLCOND="H" D CLEAR Q
  1. I '$D(^AUPNPROB(GMPLZ,0)) D CLEAR Q
  1. D NODE0
  1. Q
  1. ;
  1. CALL1(GMPLZ) ; Call 1 - Get Node 1
  1. N GMPLCOND I $P($G(^AUPNPROB(GMPLZ,1)),"^",2)="H" S GMPLCOND="H" D CLEAR Q
  1. I '$D(^AUPNPROB(GMPLZ,0)) D CLEAR Q
  1. D NODE1
  1. Q
  1. ;
  1. CALL2(GMPLZ) ; Call 2 - Get both Node 0 and Node 1
  1. I $P($G(^AUPNPROB(GMPLZ,1)),"^",2)="H" S GMPLCOND="H" D CLEAR Q
  1. I '$D(^AUPNPROB(GMPLZ,0)) D CLEAR Q
  1. D NODE0,NODE1
  1. Q
  1. ;
  1. NODE0 ; Set Node 0 data variables
  1. N GMPLZ0
  1. S GMPLZ0=$G(^AUPNPROB(GMPLZ,0))
  1. ; Diagnosis
  1. S GMPLICD=$P(GMPLZ0,U)
  1. ; Patient Name
  1. S GMPLPNAM=$P(GMPLZ0,U,2)
  1. ; Date Last Modifed
  1. S GMPLDLM=$P(GMPLZ0,U,3)
  1. ; Provider Narrative
  1. S GMPLTXT=$P(GMPLZ0,U,5)
  1. ; Status
  1. S GMPLSTAT=$P(GMPLZ0,U,12)
  1. ; Date of Onset
  1. S GMPLODAT=$P(GMPLZ0,U,13)
  1. ; Date Entered
  1. S:'GMPLODAT GMPLODAT=$P(GMPLZ0,U,8)
  1. Q
  1. ;
  1. NODE1 ; Set Node 1 data variables
  1. N GMPLZ1
  1. S GMPLZ1=$G(^AUPNPROB(GMPLZ,1))
  1. ; Problem
  1. S GMPLLEX=$P(GMPLZ1,U)
  1. ; Condition
  1. S GMPLCOND=$P(GMPLZ1,U,2)
  1. ; Recording Provider
  1. S GMPLPRV=$P(GMPLZ1,U,4)
  1. ; Responsible Provider
  1. S:'GMPLPRV GMPLPRV=$P(GMPLZ1,U,5)
  1. ; Date Resolved
  1. S GMPLXDAT=$P(GMPLZ1,U,7)
  1. ; Priority
  1. S GMPLPRIO=$P(GMPLZ1,U,14)
  1. Q
  1. ;
  1. CLEAR ; Set Variables Equal to Null
  1. S (GMPLZ0,GMPLICD,GMPLPNAM,GMPLDLM,GMPLTXT,GMPLSTAT,GMPLODAT)=""
  1. S (GMPLZ1,GMPLLEX,GMPLPRV,GMPLXDAT,GMPLPRIO,GMPLCOND)=""
  1. Q
  1. MOD(DFN) ; Return the Date the Patients Problem List was Last Modified
  1. Q +$O(^AUPNPROB("MODIFIED",DFN,0))
  1. LIST ; Returns list of Problems for Patient
  1. ;
  1. ; Input GMPDFN Pointer to Patient file #2
  1. ; GMPCOMP Display Comments 1/0
  1. ; GMTSTAT Status A/I/""
  1. ;
  1. ; Output GMPL Array, passed by reference
  1. ; GMPL(#)
  1. ; Piece 1: Pointer to Problem #9000011
  1. ; 2: Status
  1. ; 3: Provider Narrative
  1. ; 4: ICD code
  1. ; 5: Date of Onset
  1. ; 6: Date Last Modified
  1. ; 7: Service Connected
  1. ; 8: Special Exposures
  1. ; 9: Priority
  1. ; 10: Transcribed Problem or not
  1. ; 11: SNOMED-CT Concept code
  1. ; 12: SNOMED-CT Designation code
  1. ; 13: ICD Coding System (ex: ICD-10-CM="10D", ICD-9-CM="ICD")
  1. ; GMPL(1,"ICDD") ICD Description
  1. ; GMPL(#,C#) Comments
  1. ; GMPL(0) Number of Problems Returned
  1. ;
  1. N CNT,NUM,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL
  1. Q:$G(GMPDFN)'>0 S CNT=0
  1. S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R"
  1. S GMPLVIEW("ACT")=GMPSTAT,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,GMPL802,ICD,ICDD,IFN,LASTMOD,ONSET,SC,SCS,SCTC,SCTD,SP,ST,GMPLCSYS,GMPLDT
  1. . S IFN=+GMPLIST(NUM) Q:IFN'>0
  1. . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),GMPL802=$G(^(802)),CNT=CNT+1
  1. . S GMPLDT=$S(+$P(GMPL802,U,1):$P(GMPL802,U,1),1:$P(GMPL0,U,8)),GMPLCSYS=$S($P(GMPL802,U,2)]"":$P(GMPL802,U,2),1:$$SAB^ICDEX($$CSI^ICDEX(80,+GMPL0),GMPLDT))
  1. . S ICD=$P($$ICDDATA^ICDXCODE(GMPLCSYS,+GMPL0,GMPLDT,"I"),U,2),LASTMOD=$P(GMPL0,U,3)
  1. . S ST=$P(GMPL0,U,12),ONSET=$P(GMPL0,U,13)
  1. . S SC=$S(+$P(GMPL1,U,10):"SC",$P(GMPL1,U,10)=0:"NSC",1:"")
  1. . D SCS^GMPLX1(IFN,.SCS) S SP=$G(SCS(3))
  1. . S SCTC=$P(GMPL800,U),SCTD=$P(GMPL800,U,2)
  1. . I +SCTC'>0&(+SCTD'>0) S ICDD=$$ICDDESC^GMPLUTL2(ICD,GMPLDT,GMPLCSYS)
  1. . S GMPL(CNT)=IFN_U_ST_U_$$PROBTEXT^GMPLX(IFN)_U_ICD_U_ONSET_U_LASTMOD_U_SC_U_SP_U_$S($P(GMPL1,U,14)="A":"*",1:"")_U_$S('$P($G(^GMPL(125.99,1,0)),U,2):"",$P(GMPL1,U,2)'="T":"",1:"$")_U_SCTC_U_SCTD_U_GMPLCSYS
  1. . I $L($G(ICDD)) S GMPL(CNT,"ICDD")=ICDD
  1. . I $G(GMPCOMM) D
  1. . . N FAC,NIFN,NOTE,NOTECNT
  1. . . S NOTECNT=0,FAC=0
  1. . . F S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D
  1. . . . S NIFN=0
  1. . . . F S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D
  1. . . . . S NOTE=$P($G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)),U,3)
  1. . . . . S NOTECNT=NOTECNT+1,GMPL(CNT,NOTECNT)=NOTE
  1. S GMPL(0)=CNT
  1. Q