GMPLUTL3 ; SLC/JST/JVS/TC -- PL Utilities (CIRN) ;16-Sep-2015 16:24;DU
;;2.0;Problem List;**14,15,19,25,26,1003,36,1004**;Aug 25, 1994;Build 10
;
; External References
; DBIA 3990 $$ICDDX^ICDCODE
;
; This routine is primarily called by CIRN for use
; in HL7 (RGHOPL), and Historical Load (RGHOPLB),
; record creation.
;
; NOTE: This routine DOES NOT NEW the variables
; that are set below.
;
CALL0(GMPLZ) ; Call 0 - Get Node 0
N GMPLCOND I $P($G(^AUPNPROB(GMPLZ,1)),"^",2)="H" S GMPLCOND="H" D CLEAR Q
I '$D(^AUPNPROB(GMPLZ,0)) D CLEAR Q
D NODE0
Q
;
CALL1(GMPLZ) ; Call 1 - Get Node 1
N GMPLCOND I $P($G(^AUPNPROB(GMPLZ,1)),"^",2)="H" S GMPLCOND="H" D CLEAR Q
I '$D(^AUPNPROB(GMPLZ,0)) D CLEAR Q
D NODE1
Q
;
CALL2(GMPLZ) ; Call 2 - Get both Node 0 and Node 1
I $P($G(^AUPNPROB(GMPLZ,1)),"^",2)="H" S GMPLCOND="H" D CLEAR Q
I '$D(^AUPNPROB(GMPLZ,0)) D CLEAR Q
D NODE0,NODE1
Q
;
NODE0 ; Set Node 0 data variables
N GMPLZ0
S GMPLZ0=$G(^AUPNPROB(GMPLZ,0))
; Diagnosis
S GMPLICD=$P(GMPLZ0,U)
; Patient Name
S GMPLPNAM=$P(GMPLZ0,U,2)
; Date Last Modifed
S GMPLDLM=$P(GMPLZ0,U,3)
; Provider Narrative
;IHS/MSC/MGH Changed narrative to find SNOMED
;S GMPLTXT=$P(GMPLZ0,U,5)
S GMPLTXT=$$GET1^DIQ(9000011,GMPLZ,.05)
; Status
S GMPLSTAT=$P(GMPLZ0,U,12)
; Date of Onset
S GMPLODAT=$P(GMPLZ0,U,13)
; Date Entered
S:'GMPLODAT GMPLODAT=$P(GMPLZ0,U,8)
Q
;
NODE1 ; Set Node 1 data variables
N GMPLZ1
S GMPLZ1=$G(^AUPNPROB(GMPLZ,1))
; Problem
S GMPLLEX=$P(GMPLZ1,U)
; Condition
S GMPLCOND=$P(GMPLZ1,U,2)
; Recording Provider
S GMPLPRV=$P(GMPLZ1,U,4)
; Responsible Provider
S:'GMPLPRV GMPLPRV=$P(GMPLZ1,U,5)
; Date Resolved
S GMPLXDAT=$P(GMPLZ1,U,7)
; Priority
S GMPLPRIO=$P(GMPLZ1,U,14)
Q
;
CLEAR ; Set Variables Equal to Null
S (GMPLZ0,GMPLICD,GMPLPNAM,GMPLDLM,GMPLTXT,GMPLSTAT,GMPLODAT)=""
S (GMPLZ1,GMPLLEX,GMPLPRV,GMPLXDAT,GMPLPRIO,GMPLCOND)=""
Q
MOD(DFN) ; Return the Date the Patients Problem List was Last Modified
Q +$O(^AUPNPROB("MODIFIED",DFN,0))
LIST ; Returns list of Problems for Patient
;
; Input GMPDFN Pointer to Patient file #2
; GMPCOMP Display Comments 1/0
; GMTSTAT Status A/I/""
;
; Output GMPL Array, passed by reference
; GMPL(#)
; Piece 1: Pointer to Problem #9000011
; 2: Status
; 3: Provider Narrative
; 4: ICD-9 code
; 5: Date of Onset
; 6: Date Last Modified
; 7: Service Connected
; 8: Special Exposures
; 9: Priority
; 10: Transcribed Problem or not
; 11: SNOMED-CT Concept code
; 12: SNOMED-CT Designation code
; GMPL(1,"ICDD") ICD-9 Description
; GMPL(#,C#) Comments
; GMPL(0) Number of Problems Returned
;
N CNT,NUM,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL
Q:$G(GMPDFN)'>0 S CNT=0
S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R"
S GMPLVIEW("ACT")=GMPSTAT,GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")=""
D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D
. N GMPL0,GMPL1,GMPL800,ICD,ICDD,IFN,LASTMOD,ONSET,SC,SCS,SCTC,SCTD,SP,ST
. S IFN=+GMPLIST(NUM) Q:IFN'>0
. S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),CNT=CNT+1
. S ICD=$P($$ICDDX^ICDCODE(+GMPL0),U,2),LASTMOD=$P(GMPL0,U,3)
. S ST=$P(GMPL0,U,12),ONSET=$P(GMPL0,U,13)
. S SC=$S(+$P(GMPL1,U,10):"SC",$P(GMPL1,U,10)=0:"NSC",1:"")
. D SCS^GMPLX1(IFN,.SCS) S SP=$G(SCS(3))
. ;IHS/MSC/MGH Changed narrative to find SNOMED
. S NARR=$$GET1^DIQ(9000011,IFN,.05)
. I $P(NARR,"|",2)=""!($P(NARR,"|",2)=" ") S NARR=$P(NARR,"|",1)
. S SCTC=$P(GMPL800,U),SCTD=$P(GMPL800,U,2)
. I +SCTC'>0&(+SCTD'>0) S ICDD=$$ICDDESC^GMPLUTL2(ICD,$P(GMPL0,U,8))
. ;IHS/MSC/MGH Use narrative
. ;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
. S GMPL(CNT)=IFN_U_ST_U_NARR_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
. I $L($G(ICDD)) S GMPL(CNT,"ICDD")=ICDD
. I $G(GMPCOMM) D
. . N FAC,NIFN,NOTE,NOTECNT
. . S NOTECNT=0,FAC=0
. . F S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D
. . . S NIFN=0
. . . F S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D
. . . . S NOTE=$P($G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)),U,3)
. . . . S NOTECNT=NOTECNT+1,GMPL(CNT,NOTECNT)=NOTE
S GMPL(0)=CNT
Q
GMPLUTL3 ; SLC/JST/JVS/TC -- PL Utilities (CIRN) ;16-Sep-2015 16:24;DU
+1 ;;2.0;Problem List;**14,15,19,25,26,1003,36,1004**;Aug 25, 1994;Build 10
+2 ;
+3 ; External References
+4 ; DBIA 3990 $$ICDDX^ICDCODE
+5 ;
+6 ; This routine is primarily called by CIRN for use
+7 ; in HL7 (RGHOPL), and Historical Load (RGHOPLB),
+8 ; record creation.
+9 ;
+10 ; NOTE: This routine DOES NOT NEW the variables
+11 ; that are set below.
+12 ;
CALL0(GMPLZ) ; Call 0 - Get Node 0
+1 NEW GMPLCOND
IF $PIECE($GET(^AUPNPROB(GMPLZ,1)),"^",2)="H"
SET GMPLCOND="H"
DO CLEAR
QUIT
+2 IF '$DATA(^AUPNPROB(GMPLZ,0))
DO CLEAR
QUIT
+3 DO NODE0
+4 QUIT
+5 ;
CALL1(GMPLZ) ; Call 1 - Get Node 1
+1 NEW GMPLCOND
IF $PIECE($GET(^AUPNPROB(GMPLZ,1)),"^",2)="H"
SET GMPLCOND="H"
DO CLEAR
QUIT
+2 IF '$DATA(^AUPNPROB(GMPLZ,0))
DO CLEAR
QUIT
+3 DO NODE1
+4 QUIT
+5 ;
CALL2(GMPLZ) ; Call 2 - Get both Node 0 and Node 1
+1 IF $PIECE($GET(^AUPNPROB(GMPLZ,1)),"^",2)="H"
SET GMPLCOND="H"
DO CLEAR
QUIT
+2 IF '$DATA(^AUPNPROB(GMPLZ,0))
DO CLEAR
QUIT
+3 DO NODE0
DO NODE1
+4 QUIT
+5 ;
NODE0 ; Set Node 0 data variables
+1 NEW GMPLZ0
+2 SET GMPLZ0=$GET(^AUPNPROB(GMPLZ,0))
+3 ; Diagnosis
+4 SET GMPLICD=$PIECE(GMPLZ0,U)
+5 ; Patient Name
+6 SET GMPLPNAM=$PIECE(GMPLZ0,U,2)
+7 ; Date Last Modifed
+8 SET GMPLDLM=$PIECE(GMPLZ0,U,3)
+9 ; Provider Narrative
+10 ;IHS/MSC/MGH Changed narrative to find SNOMED
+11 ;S GMPLTXT=$P(GMPLZ0,U,5)
+12 SET GMPLTXT=$$GET1^DIQ(9000011,GMPLZ,.05)
+13 ; Status
+14 SET GMPLSTAT=$PIECE(GMPLZ0,U,12)
+15 ; Date of Onset
+16 SET GMPLODAT=$PIECE(GMPLZ0,U,13)
+17 ; Date Entered
+18 IF 'GMPLODAT
SET GMPLODAT=$PIECE(GMPLZ0,U,8)
+19 QUIT
+20 ;
NODE1 ; Set Node 1 data variables
+1 NEW GMPLZ1
+2 SET GMPLZ1=$GET(^AUPNPROB(GMPLZ,1))
+3 ; Problem
+4 SET GMPLLEX=$PIECE(GMPLZ1,U)
+5 ; Condition
+6 SET GMPLCOND=$PIECE(GMPLZ1,U,2)
+7 ; Recording Provider
+8 SET GMPLPRV=$PIECE(GMPLZ1,U,4)
+9 ; Responsible Provider
+10 IF 'GMPLPRV
SET GMPLPRV=$PIECE(GMPLZ1,U,5)
+11 ; Date Resolved
+12 SET GMPLXDAT=$PIECE(GMPLZ1,U,7)
+13 ; Priority
+14 SET GMPLPRIO=$PIECE(GMPLZ1,U,14)
+15 QUIT
+16 ;
CLEAR ; Set Variables Equal to Null
+1 SET (GMPLZ0,GMPLICD,GMPLPNAM,GMPLDLM,GMPLTXT,GMPLSTAT,GMPLODAT)=""
+2 SET (GMPLZ1,GMPLLEX,GMPLPRV,GMPLXDAT,GMPLPRIO,GMPLCOND)=""
+3 QUIT
MOD(DFN) ; Return the Date the Patients Problem List was Last Modified
+1 QUIT +$ORDER(^AUPNPROB("MODIFIED",DFN,0))
LIST ; Returns list of Problems for Patient
+1 ;
+2 ; Input GMPDFN Pointer to Patient file #2
+3 ; GMPCOMP Display Comments 1/0
+4 ; GMTSTAT Status A/I/""
+5 ;
+6 ; Output GMPL Array, passed by reference
+7 ; GMPL(#)
+8 ; Piece 1: Pointer to Problem #9000011
+9 ; 2: Status
+10 ; 3: Provider Narrative
+11 ; 4: ICD-9 code
+12 ; 5: Date of Onset
+13 ; 6: Date Last Modified
+14 ; 7: Service Connected
+15 ; 8: Special Exposures
+16 ; 9: Priority
+17 ; 10: Transcribed Problem or not
+18 ; 11: SNOMED-CT Concept code
+19 ; 12: SNOMED-CT Designation code
+20 ; GMPL(1,"ICDD") ICD-9 Description
+21 ; GMPL(#,C#) Comments
+22 ; GMPL(0) Number of Problems Returned
+23 ;
+24 NEW CNT,NUM,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL
+25 IF $GET(GMPDFN)'>0
QUIT
SET CNT=0
+26 SET GMPARAM("QUIET")=1
SET GMPARAM("REV")=$PIECE($GET(^GMPL(125.99,1,0)),U,5)="R"
+27 SET GMPLVIEW("ACT")=GMPSTAT
SET GMPLVIEW("PROV")=0
SET GMPLVIEW("VIEW")=""
+28 DO GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
+29 FOR NUM=0:0
SET NUM=$ORDER(GMPLIST(NUM))
IF NUM'>0
QUIT
Begin DoDot:1
+30 NEW GMPL0,GMPL1,GMPL800,ICD,ICDD,IFN,LASTMOD,ONSET,SC,SCS,SCTC,SCTD,SP,ST
+31 SET IFN=+GMPLIST(NUM)
IF IFN'>0
QUIT
+32 SET GMPL0=$GET(^AUPNPROB(IFN,0))
SET GMPL1=$GET(^(1))
SET GMPL800=$GET(^(800))
SET CNT=CNT+1
+33 SET ICD=$PIECE($$ICDDX^ICDCODE(+GMPL0),U,2)
SET LASTMOD=$PIECE(GMPL0,U,3)
+34 SET ST=$PIECE(GMPL0,U,12)
SET ONSET=$PIECE(GMPL0,U,13)
+35 SET SC=$SELECT(+$PIECE(GMPL1,U,10):"SC",$PIECE(GMPL1,U,10)=0:"NSC",1:"")
+36 DO SCS^GMPLX1(IFN,.SCS)
SET SP=$GET(SCS(3))
+37 ;IHS/MSC/MGH Changed narrative to find SNOMED
+38 SET NARR=$$GET1^DIQ(9000011,IFN,.05)
+39 IF $PIECE(NARR,"|",2)=""!($PIECE(NARR,"|",2)=" ")
SET NARR=$PIECE(NARR,"|",1)
+40 SET SCTC=$PIECE(GMPL800,U)
SET SCTD=$PIECE(GMPL800,U,2)
+41 IF +SCTC'>0&(+SCTD'>0)
SET ICDD=$$ICDDESC^GMPLUTL2(ICD,$PIECE(GMPL0,U,8))
+42 ;IHS/MSC/MGH Use narrative
+43 ;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
+44 SET GMPL(CNT)=IFN_U_ST_U_NARR_U_ICD_U_ONSET_U_LASTMOD_U_SC_U_SP_U_$SELECT($PIECE(GMPL1,U,14)="A":"*",1:"")_U_$SELECT('$PIECE($GET(^GMPL(125.99,1,0)),U,2):"",$PIECE(GMPL1,U,2)'="T":"",1:"$")_U_SCTC_U_SCTD
+45 IF $LENGTH($GET(ICDD))
SET GMPL(CNT,"ICDD")=ICDD
+46 IF $GET(GMPCOMM)
Begin DoDot:2
+47 NEW FAC,NIFN,NOTE,NOTECNT
+48 SET NOTECNT=0
SET FAC=0
+49 FOR
SET FAC=$ORDER(^AUPNPROB(IFN,11,FAC))
IF +FAC'>0
QUIT
Begin DoDot:3
+50 SET NIFN=0
+51 FOR
SET NIFN=$ORDER(^AUPNPROB(IFN,11,FAC,11,NIFN))
IF NIFN'>0
QUIT
Begin DoDot:4
+52 SET NOTE=$PIECE($GET(^AUPNPROB(IFN,11,FAC,11,NIFN,0)),U,3)
+53 SET NOTECNT=NOTECNT+1
SET GMPL(CNT,NOTECNT)=NOTE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+54 SET GMPL(0)=CNT
+55 QUIT
