GMPLENFM ; SLC/MKB/KER -- Problem List Enc Form utilities ;11/20/12 15:03
;;2.0;Problem List;**3,4,7,26,35,36**;Aug 25, 1994;Build 65
;
; External References
; DBIA 1609 CONFIG^LEXSET
; DBIA 3990 $$ICDDX^ICDCODE
; DBIA 10006 ^DIC
;
ACTIVE ; List of Active Problems for DFN
; Input variables:
; DFN Patient ID (Required)
; [GMPLINDT] Date of Interest (Optional - defaults to today)
; This is the date to use for evalutation of the
; Activation status of ICD-9-CM and SNOMED CT codes
;
; Sets Global Array:
; ^TMP("IB",$J,"INTERFACES",DFN,"GMP PATIENT ACTIVE PROBLEMS",#) =
;
; Piece 1: Problem text
; 2: ICD code
; 3: Date of Onset 00/00/00 format
; 4: SC/NSC/"" serv-conn/not sc/unknown
; 5: Y/N/"" serv-conn/not sc/unknown
; 6: A/I/E/H/M/C/S/"" If problem is flagged as:
; A - Agent Orange
; I - Ionizing Radiation
; E - Environmental Contaminants
; H - Head/Neck Cancer
; M - Mil Sexual Trauma
; C - Combat Vet
; S - SHAD
; - None
; 7: Special Exposure Full text of piece 6
; 8: SNOMED-CT Concept Code
; 9: SNOMED-CT Designation Code
; 10: VHAT Concept VUID
; 11: VHAT Designation VUID
; 12: Code Status (# -> ICD code inactive, $ -> SNOMED CT inactive,
; #$ -> Both ICD & SNOMED CT inactive, else "")
;
N IFN,PROB,CNT,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL
N GMPDFN,NODE,GMPDT
Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0))
S GMPDT=$G(GMPINDT,$$DT^XLFDT)
S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1
S GMPLVIEW("ACT")="A",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,CODESTAT,ICDC,ICDI,SCTC,SCTD,VHATC,VHATD
. S IFN=GMPLIST(NUM) Q:IFN'>0
. S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),CODESTAT=""
. S ICDC=$P($$ICDDX^ICDCODE(+GMPL0),U,2),CODESTAT=CODESTAT_$S(+$$STATCHK^ICDAPIU(ICDC,GMPDT):"",1:"#")
. S ICDI=0 F S ICDI=$O(^AUPNPROB(IFN,803,ICDI)) Q:+ICDI'>0 D
.. N ICDMC S ICDMC=$P($G(^AUPNPROB(IFN,803,ICDI,0)),U)
.. S ICDC=ICDC_"/"_ICDMC
.. I CODESTAT'["#" S CODESTAT=CODESTAT_$S(+$$STATCHK^ICDAPIU(ICDMC,GMPDT):"",1:"#")
. S SCTC=$P(GMPL800,U),SCTD=$P(GMPL800,U,2),VHATC=$P(GMPL800,U,3),VHATD=$P(GMPL800,U,4)
. S CODESTAT=CODESTAT_$S(+$$STATCHK^LEXSRC2(SCTC,GMPDT):"",1:"$")
. S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1
. I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB
. S PROB=PROB_U_ICDC
. S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10)
. S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^")
. S PROB=PROB_U_$$TXFCTR(GMPL1)_U_SCTC_U_SCTD_U_VHATC_U_VHATD_U_CODESTAT
. S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",CNT)=PROB
S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",0)=CNT
Q
;
SELECT ; Select Common Problems
; Sets Global Array:
; ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")
; Piece 1: Pointer to Clinical Lexicon
; 2: Problem Text
; 3: ICD Code (null if unknown)
;
N X,Y,DIC,PROB D CONFIG^LEXSET("","PLS")
K ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")
S DIC("A")="Select PROBLEM: ",DIC(0)="AEQM",DIC="^LEX(757.01,"
D ^DIC Q:+Y<0 S PROB=Y I +Y'>1 S PROB=+Y_U_X
S PROB=PROB_U_$G(Y(1))
S ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")=PROB
Q
;
DSELECT ; List of Active Problems for DFN
; Input variables:
; DFN Patient ID (Required)
; [GMPLINDT] Date of Interest (Optional - defaults to today)
; This is the date to use for evalutation of the
; Activation status of ICD-9-CM and SNOMED CT codes
;
; Sets Global Array"
; ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",#) =
;
; Piece 1: Problem IEN
; 2: Problem Text
; 3: ICD code
; 4: Date of Onset 00/00/00 format
; 5: SC/NSC/"" serv-conn/not sc/unknown
; 6: Y/N/"" serv-conn/not sc/unknown
; 7: A/I/E/H/M/C/S/"" If problem is flagged as:
; A - Agent Orange
; I - Ionizing Radiation
; E - Environmental Contaminants
; H - Head/Neck Cancer
; M - Mil Sexual Trauma
; C - Combat Vet
; S - SHAD
; - None
; 8: Special Exposure Full text of piece 6
; 9: SNOMED-CT Concept Code
; 10: SNOMED-CT Designation Code
; 11: VHAT Concept VUID
; 12: VHAT Designation VUID
; 13: Code Status (# -> ICD code inactive, $ -> SNOMED CT inactive,
; #$ -> Both ICD & SNOMED CT inactive, else "")
;
N IFN,PROB,CNT,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL,GMPDFN,NODE,GMPDT
Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0))
S GMPDT=$G(GMPINDT,$$DT^XLFDT)
S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1
S GMPLVIEW("ACT")="A",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,CODESTAT,ICDC,ICDI,SCTC,SCTD,VHATC,VHATD
. S IFN=GMPLIST(NUM) Q:IFN'>0
. S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),CODESTAT=""
. S ICDC=$P($$ICDDX^ICDCODE(+GMPL0),U,2)
. S:ICDC]"" CODESTAT=CODESTAT_$S(+$$STATCHK^ICDAPIU(ICDC,GMPDT):"",1:"#")
. S ICDI=0 F S ICDI=$O(^AUPNPROB(IFN,803,ICDI)) Q:+ICDI'>0 D
.. N ICDMC S ICDMC=$P($G(^AUPNPROB(IFN,803,ICDI,0)),U) Q:ICDMC']""
.. S ICDC=ICDC_"/"_ICDMC
.. I CODESTAT'["#" S CODESTAT=CODESTAT_$S(+$$STATCHK^ICDAPIU(ICDMC,GMPDT):"",1:"#")
. S SCTC=$P(GMPL800,U),SCTD=$P(GMPL800,U,2),VHATC=$P(GMPL800,U,3),VHATD=$P(GMPL800,U,4)
. S:SCTC]"" CODESTAT=CODESTAT_$S(+$$STATCHK^LEXSRC2(SCTC,GMPDT):"",1:"$")
. S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1
. I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB
. S PROB=IFN_U_PROB
. S PROB=PROB_U_ICDC
. S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10)
. S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^")
. S PROB=PROB_U_$$TXFCTR(GMPL1)_U_SCTC_U_SCTD_U_VHATC_U_VHATD_U_CODESTAT
. S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",CNT)=PROB
S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=CNT
Q
;
TXFCTR(GMPL1) ;Determine Treatment Factor, if any
N NXTTF,TXFACTOR
S TXFACTOR="^"
F NXTTF=11,12,13,15,16,17,18 I $P(GMPL1,U,NXTTF) S TXFACTOR=$P("A^Agent Orange;I^Ionizing Radiation;E^Env. Contaminants;;H^Head/Neck Cancer;M^Mil Sexual Trauma;C^Combat Vet;S^SHAD",";",NXTTF-10) Q
Q TXFACTOR
GMPLENFM ; SLC/MKB/KER -- Problem List Enc Form utilities ;11/20/12 15:03
+1 ;;2.0;Problem List;**3,4,7,26,35,36**;Aug 25, 1994;Build 65
+2 ;
+3 ; External References
+4 ; DBIA 1609 CONFIG^LEXSET
+5 ; DBIA 3990 $$ICDDX^ICDCODE
+6 ; DBIA 10006 ^DIC
+7 ;
ACTIVE ; List of Active Problems for DFN
+1 ; Input variables:
+2 ; DFN Patient ID (Required)
+3 ; [GMPLINDT] Date of Interest (Optional - defaults to today)
+4 ; This is the date to use for evalutation of the
+5 ; Activation status of ICD-9-CM and SNOMED CT codes
+6 ;
+7 ; Sets Global Array:
+8 ; ^TMP("IB",$J,"INTERFACES",DFN,"GMP PATIENT ACTIVE PROBLEMS",#) =
+9 ;
+10 ; Piece 1: Problem text
+11 ; 2: ICD code
+12 ; 3: Date of Onset 00/00/00 format
+13 ; 4: SC/NSC/"" serv-conn/not sc/unknown
+14 ; 5: Y/N/"" serv-conn/not sc/unknown
+15 ; 6: A/I/E/H/M/C/S/"" If problem is flagged as:
+16 ; A - Agent Orange
+17 ; I - Ionizing Radiation
+18 ; E - Environmental Contaminants
+19 ; H - Head/Neck Cancer
+20 ; M - Mil Sexual Trauma
+21 ; C - Combat Vet
+22 ; S - SHAD
+23 ; - None
+24 ; 7: Special Exposure Full text of piece 6
+25 ; 8: SNOMED-CT Concept Code
+26 ; 9: SNOMED-CT Designation Code
+27 ; 10: VHAT Concept VUID
+28 ; 11: VHAT Designation VUID
+29 ; 12: Code Status (# -> ICD code inactive, $ -> SNOMED CT inactive,
+30 ; #$ -> Both ICD & SNOMED CT inactive, else "")
+31 ;
+32 NEW IFN,PROB,CNT,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL
+33 NEW GMPDFN,NODE,GMPDT
+34 IF $GET(DFN)'>0
QUIT
SET GMPDFN=DFN
SET CNT=0
SET NODE=$GET(^GMPL(125.99,1,0))
+35 SET GMPDT=$GET(GMPINDT,$$DT^XLFDT)
+36 SET GMPARAM("VER")=$PIECE(NODE,U,2)
SET GMPARAM("REV")=$PIECE(NODE,U,5)="R"
SET GMPARAM("QUIET")=1
+37 SET GMPLVIEW("ACT")="A"
SET GMPLVIEW("PROV")=0
SET GMPLVIEW("VIEW")=""
+38 DO GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
+39 FOR NUM=0:0
SET NUM=$ORDER(GMPLIST(NUM))
IF NUM'>0
QUIT
Begin DoDot:1
+40 NEW GMPL0,GMPL1,GMPL800,CODESTAT,ICDC,ICDI,SCTC,SCTD,VHATC,VHATD
+41 SET IFN=GMPLIST(NUM)
IF IFN'>0
QUIT
+42 SET GMPL0=$GET(^AUPNPROB(IFN,0))
SET GMPL1=$GET(^(1))
SET GMPL800=$GET(^(800))
SET CODESTAT=""
+43 SET ICDC=$PIECE($$ICDDX^ICDCODE(+GMPL0),U,2)
SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^ICDAPIU(ICDC,GMPDT):"",1:"#")
+44 SET ICDI=0
FOR
SET ICDI=$ORDER(^AUPNPROB(IFN,803,ICDI))
IF +ICDI'>0
QUIT
Begin DoDot:2
+45 NEW ICDMC
SET ICDMC=$PIECE($GET(^AUPNPROB(IFN,803,ICDI,0)),U)
+46 SET ICDC=ICDC_"/"_ICDMC
+47 IF CODESTAT'["#"
SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^ICDAPIU(ICDMC,GMPDT):"",1:"#")
End DoDot:2
+48 SET SCTC=$PIECE(GMPL800,U)
SET SCTD=$PIECE(GMPL800,U,2)
SET VHATC=$PIECE(GMPL800,U,3)
SET VHATD=$PIECE(GMPL800,U,4)
+49 SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^LEXSRC2(SCTC,GMPDT):"",1:"$")
+50 SET PROB=$$PROBTEXT^GMPLX(IFN)
SET CNT=CNT+1
+51 IF GMPARAM("VER")
IF $PIECE(GMPL1,U,2)="T"
SET PROB="$"_PROB
+52 SET PROB=PROB_U_ICDC
+53 SET PROB=PROB_U_$$EXTDT^GMPLX($PIECE(GMPL0,U,13))
SET SC=$PIECE(GMPL1,U,10)
+54 SET PROB=PROB_U_$SELECT(+SC:"SC^Y",SC=0:"NSC^N",1:"^")
+55 SET PROB=PROB_U_$$TXFCTR(GMPL1)_U_SCTC_U_SCTD_U_VHATC_U_VHATD_U_CODESTAT
+56 SET ^TMP("IB",$JOB,"INTERFACES",+$GET(DFN),"GMP PATIENT ACTIVE PROBLEMS",CNT)=PROB
End DoDot:1
+57 SET ^TMP("IB",$JOB,"INTERFACES",+$GET(DFN),"GMP PATIENT ACTIVE PROBLEMS",0)=CNT
+58 QUIT
+59 ;
SELECT ; Select Common Problems
+1 ; Sets Global Array:
+2 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")
+3 ; Piece 1: Pointer to Clinical Lexicon
+4 ; 2: Problem Text
+5 ; 3: ICD Code (null if unknown)
+6 ;
+7 NEW X,Y,DIC,PROB
DO CONFIG^LEXSET("","PLS")
+8 KILL ^TMP("IB",$JOB,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")
+9 SET DIC("A")="Select PROBLEM: "
SET DIC(0)="AEQM"
SET DIC="^LEX(757.01,"
+10 DO ^DIC
IF +Y<0
QUIT
SET PROB=Y
IF +Y'>1
SET PROB=+Y_U_X
+11 SET PROB=PROB_U_$GET(Y(1))
+12 SET ^TMP("IB",$JOB,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")=PROB
+13 QUIT
+14 ;
DSELECT ; List of Active Problems for DFN
+1 ; Input variables:
+2 ; DFN Patient ID (Required)
+3 ; [GMPLINDT] Date of Interest (Optional - defaults to today)
+4 ; This is the date to use for evalutation of the
+5 ; Activation status of ICD-9-CM and SNOMED CT codes
+6 ;
+7 ; Sets Global Array"
+8 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",#) =
+9 ;
+10 ; Piece 1: Problem IEN
+11 ; 2: Problem Text
+12 ; 3: ICD code
+13 ; 4: Date of Onset 00/00/00 format
+14 ; 5: SC/NSC/"" serv-conn/not sc/unknown
+15 ; 6: Y/N/"" serv-conn/not sc/unknown
+16 ; 7: A/I/E/H/M/C/S/"" If problem is flagged as:
+17 ; A - Agent Orange
+18 ; I - Ionizing Radiation
+19 ; E - Environmental Contaminants
+20 ; H - Head/Neck Cancer
+21 ; M - Mil Sexual Trauma
+22 ; C - Combat Vet
+23 ; S - SHAD
+24 ; - None
+25 ; 8: Special Exposure Full text of piece 6
+26 ; 9: SNOMED-CT Concept Code
+27 ; 10: SNOMED-CT Designation Code
+28 ; 11: VHAT Concept VUID
+29 ; 12: VHAT Designation VUID
+30 ; 13: Code Status (# -> ICD code inactive, $ -> SNOMED CT inactive,
+31 ; #$ -> Both ICD & SNOMED CT inactive, else "")
+32 ;
+33 NEW IFN,PROB,CNT,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL,GMPDFN,NODE,GMPDT
+34 IF $GET(DFN)'>0
QUIT
SET GMPDFN=DFN
SET CNT=0
SET NODE=$GET(^GMPL(125.99,1,0))
+35 SET GMPDT=$GET(GMPINDT,$$DT^XLFDT)
+36 SET GMPARAM("VER")=$PIECE(NODE,U,2)
SET GMPARAM("REV")=$PIECE(NODE,U,5)="R"
SET GMPARAM("QUIET")=1
+37 SET GMPLVIEW("ACT")="A"
SET GMPLVIEW("PROV")=0
SET GMPLVIEW("VIEW")=""
+38 DO GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
+39 FOR NUM=0:0
SET NUM=$ORDER(GMPLIST(NUM))
IF NUM'>0
QUIT
Begin DoDot:1
+40 NEW GMPL0,GMPL1,GMPL800,CODESTAT,ICDC,ICDI,SCTC,SCTD,VHATC,VHATD
+41 SET IFN=GMPLIST(NUM)
IF IFN'>0
QUIT
+42 SET GMPL0=$GET(^AUPNPROB(IFN,0))
SET GMPL1=$GET(^(1))
SET GMPL800=$GET(^(800))
SET CODESTAT=""
+43 SET ICDC=$PIECE($$ICDDX^ICDCODE(+GMPL0),U,2)
+44 IF ICDC]""
SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^ICDAPIU(ICDC,GMPDT):"",1:"#")
+45 SET ICDI=0
FOR
SET ICDI=$ORDER(^AUPNPROB(IFN,803,ICDI))
IF +ICDI'>0
QUIT
Begin DoDot:2
+46 NEW ICDMC
SET ICDMC=$PIECE($GET(^AUPNPROB(IFN,803,ICDI,0)),U)
IF ICDMC']""
QUIT
+47 SET ICDC=ICDC_"/"_ICDMC
+48 IF CODESTAT'["#"
SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^ICDAPIU(ICDMC,GMPDT):"",1:"#")
End DoDot:2
+49 SET SCTC=$PIECE(GMPL800,U)
SET SCTD=$PIECE(GMPL800,U,2)
SET VHATC=$PIECE(GMPL800,U,3)
SET VHATD=$PIECE(GMPL800,U,4)
+50 IF SCTC]""
SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^LEXSRC2(SCTC,GMPDT):"",1:"$")
+51 SET PROB=$$PROBTEXT^GMPLX(IFN)
SET CNT=CNT+1
+52 IF GMPARAM("VER")
IF $PIECE(GMPL1,U,2)="T"
SET PROB="$"_PROB
+53 SET PROB=IFN_U_PROB
+54 SET PROB=PROB_U_ICDC
+55 SET PROB=PROB_U_$$EXTDT^GMPLX($PIECE(GMPL0,U,13))
SET SC=$PIECE(GMPL1,U,10)
+56 SET PROB=PROB_U_$SELECT(+SC:"SC^Y",SC=0:"NSC^N",1:"^")
+57 SET PROB=PROB_U_$$TXFCTR(GMPL1)_U_SCTC_U_SCTD_U_VHATC_U_VHATD_U_CODESTAT
+58 SET ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",CNT)=PROB
End DoDot:1
+59 SET ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=CNT
+60 QUIT
+61 ;
TXFCTR(GMPL1) ;Determine Treatment Factor, if any
+1 NEW NXTTF,TXFACTOR
+2 SET TXFACTOR="^"
+3 FOR NXTTF=11,12,13,15,16,17,18
IF $PIECE(GMPL1,U,NXTTF)
SET TXFACTOR=$PIECE("A^Agent Orange;I^Ionizing Radiation;E^Env. Contaminants;;H^Head/Neck Cancer;M^Mil Sexual Trauma;C^Combat Vet;S^SHAD",";",NXTTF-10)
QUIT
+4 QUIT TXFACTOR
