- 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 Feb 18, 2025@23:56:59 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