GMPLUTL3 ; SLC/JST/JVS/TC -- PL Utilities (CIRN) ;08/22/12 08:50
;;2.0;Problem List;**14,15,19,25,26,36,42**;Aug 25, 1994;Build 46
;
; External References
; DBIA 5699 $$ICDDATA^ICDXCODE
;
; 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
S GMPLTXT=$P(GMPLZ0,U,5)
; 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 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
; 13: ICD Coding System (ex: ICD-10-CM="10D", ICD-9-CM="ICD")
; GMPL(1,"ICDD") ICD 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,GMPL802,ICD,ICDD,IFN,LASTMOD,ONSET,SC,SCS,SCTC,SCTD,SP,ST,GMPLCSYS,GMPLDT
. S IFN=+GMPLIST(NUM) Q:IFN'>0
. S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),GMPL802=$G(^(802)),CNT=CNT+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))
. S ICD=$P($$ICDDATA^ICDXCODE(GMPLCSYS,+GMPL0,GMPLDT,"I"),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))
. S SCTC=$P(GMPL800,U),SCTD=$P(GMPL800,U,2)
. I +SCTC'>0&(+SCTD'>0) S ICDD=$$ICDDESC^GMPLUTL2(ICD,GMPLDT,GMPLCSYS)
. 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
. 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLUTL3 4678 printed Dec 13, 2024@02:30:31 Page 2
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
+2 ;
+3 ; External References
+4 ; DBIA 5699 $$ICDDATA^ICDXCODE
+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 SET GMPLTXT=$PIECE(GMPLZ0,U,5)
+11 ; Status
+12 SET GMPLSTAT=$PIECE(GMPLZ0,U,12)
+13 ; Date of Onset
+14 SET GMPLODAT=$PIECE(GMPLZ0,U,13)
+15 ; Date Entered
+16 if 'GMPLODAT
SET GMPLODAT=$PIECE(GMPLZ0,U,8)
+17 QUIT
+18 ;
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 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 ; 13: ICD Coding System (ex: ICD-10-CM="10D", ICD-9-CM="ICD")
+21 ; GMPL(1,"ICDD") ICD Description
+22 ; GMPL(#,C#) Comments
+23 ; GMPL(0) Number of Problems Returned
+24 ;
+25 NEW CNT,NUM,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL
+26 if $GET(GMPDFN)'>0
QUIT
SET CNT=0
+27 SET GMPARAM("QUIET")=1
SET GMPARAM("REV")=$PIECE($GET(^GMPL(125.99,1,0)),U,5)="R"
+28 SET GMPLVIEW("ACT")=GMPSTAT
SET GMPLVIEW("PROV")=0
SET GMPLVIEW("VIEW")=""
+29 DO GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
+30 FOR NUM=0:0
SET NUM=$ORDER(GMPLIST(NUM))
if NUM'>0
QUIT
Begin DoDot:1
+31 NEW GMPL0,GMPL1,GMPL800,GMPL802,ICD,ICDD,IFN,LASTMOD,ONSET,SC,SCS,SCTC,SCTD,SP,ST,GMPLCSYS,GMPLDT
+32 SET IFN=+GMPLIST(NUM)
if IFN'>0
QUIT
+33 SET GMPL0=$GET(^AUPNPROB(IFN,0))
SET GMPL1=$GET(^(1))
SET GMPL800=$GET(^(800))
SET GMPL802=$GET(^(802))
SET CNT=CNT+1
+34 SET GMPLDT=$SELECT(+$PIECE(GMPL802,U,1):$PIECE(GMPL802,U,1),1:$PIECE(GMPL0,U,8))
SET GMPLCSYS=$SELECT($PIECE(GMPL802,U,2)]"":$PIECE(GMPL802,U,2),1:$$SAB^ICDEX($$CSI^ICDEX(80,+GMPL0),GMPLDT))
+35 SET ICD=$PIECE($$ICDDATA^ICDXCODE(GMPLCSYS,+GMPL0,GMPLDT,"I"),U,2)
SET LASTMOD=$PIECE(GMPL0,U,3)
+36 SET ST=$PIECE(GMPL0,U,12)
SET ONSET=$PIECE(GMPL0,U,13)
+37 SET SC=$SELECT(+$PIECE(GMPL1,U,10):"SC",$PIECE(GMPL1,U,10)=0:"NSC",1:"")
+38 DO SCS^GMPLX1(IFN,.SCS)
SET SP=$GET(SCS(3))
+39 SET SCTC=$PIECE(GMPL800,U)
SET SCTD=$PIECE(GMPL800,U,2)
+40 IF +SCTC'>0&(+SCTD'>0)
SET ICDD=$$ICDDESC^GMPLUTL2(ICD,GMPLDT,GMPLCSYS)
+41 SET GMPL(CNT)=IFN_U_ST_U_$$PROBTEXT^GMPLX(IFN)_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_U_GMPLCSYS
+42 IF $LENGTH($GET(ICDD))
SET GMPL(CNT,"ICDD")=ICDD
+43 IF $GET(GMPCOMM)
Begin DoDot:2
+44 NEW FAC,NIFN,NOTE,NOTECNT
+45 SET NOTECNT=0
SET FAC=0
+46 FOR
SET FAC=$ORDER(^AUPNPROB(IFN,11,FAC))
if +FAC'>0
QUIT
Begin DoDot:3
+47 SET NIFN=0
+48 FOR
SET NIFN=$ORDER(^AUPNPROB(IFN,11,FAC,11,NIFN))
if NIFN'>0
QUIT
Begin DoDot:4
+49 SET NOTE=$PIECE($GET(^AUPNPROB(IFN,11,FAC,11,NIFN,0)),U,3)
+50 SET NOTECNT=NOTECNT+1
SET GMPL(CNT,NOTECNT)=NOTE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 SET GMPL(0)=CNT
+52 QUIT
