GMPLENFM ; SLC/MKB/KER/TC -- Problem List Enc Form utilities ;06/12/13 09:08
;;2.0;Problem List;**3,4,7,26,35,36,42**;Aug 25, 1994;Build 46
;
; External References
; DBIA 1609 CONFIG^LEXSET
; ICR 5699 $$ICDDATA^ICDXCODE, $$STATCHK^ICDXCODE
; ICR 5747 $$CSI/SAB/CODECS^ICDEX
; DBIA 10006 ^DIC
;
ACTIVE ; List of Active Problems for DFN
; Input variables:
; DFN Patient ID (Required)
; [GMPINDT] 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 "")
; 13: ICD Coding System ("ICD": ICD-9-CM, "10D": ICD-10-CM)
;
N IFN,PROB,CNT,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL
N GMPDFN,NODE
Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0))
S GMPINDT=$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,GMPL802,GMPCSYS,GMPDT,GMPLCPTR,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)),GMPL802=$G(^(802)),CODESTAT=""
. S GMPDT=$S(+$P(GMPL802,U,1):$P(GMPL802,U,1),1:$P(GMPL0,U,8)),GMPLCPTR=$$CSI^ICDEX(80,+GMPL0)
. S GMPCSYS=$S($P(GMPL802,U,2)]"":$P(GMPL802,U,2),1:$$SAB^ICDEX(GMPLCPTR,GMPDT))
. S ICDC=$P($$ICDDATA^ICDXCODE(GMPCSYS,+GMPL0,GMPDT,"I"),U,2)
. S:ICDC]"" CODESTAT=CODESTAT_$S(+$$STATCHK^ICDXCODE(GMPLCPTR,ICDC,GMPINDT):"",1:"#")
. S ICDI=0 F S ICDI=$O(^AUPNPROB(IFN,803,ICDI)) Q:+ICDI'>0 D
.. N ICDM0,ICDMC,ICDMCSYS,ICDMDT,ICDCSPTR
.. S ICDM0=$G(^AUPNPROB(IFN,803,ICDI,0)),ICDMC=$P(ICDM0,U)
.. S ICDMCSYS=$P(ICDM0,U,2),ICDMDT=$P(ICDM0,U,3),ICDCSPTR=+$$CODECS^ICDEX(ICDMC,80,ICDMDT)
.. S ICDC=ICDC_"/"_ICDMC
.. I CODESTAT'["#" S CODESTAT=CODESTAT_$S(+$$STATCHK^ICDXCODE(ICDCSPTR,ICDMC,GMPINDT):"",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,GMPINDT,,"SCT"):"",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_U_GMPCSYS
. 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("GMPX","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)
; [GMPINDT] 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 "")
; 14: ICD coding system ("ICD": ICD-9-CM, "10D": ICD-10-CM)
;
N IFN,PROB,CNT,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL,GMPDFN,NODE
Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0))
S GMPINDT=$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,GMPL802,GMPDT,GMPCSYS,GMPLCPTR,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)),GMPL802=$G(^(802)),CODESTAT=""
. S GMPDT=$S(+$P(GMPL802,U,1):$P(GMPL802,U,1),1:$P(GMPL0,U,8)),GMPLCPTR=$$CSI^ICDEX(80,+GMPL0)
. S GMPCSYS=$S($P(GMPL802,U,2)]"":$P(GMPL802,U,2),1:$$SAB^ICDEX(GMPLCPTR,GMPDT))
. S ICDC=$P($$ICDDATA^ICDXCODE(GMPCSYS,+GMPL0,GMPDT,"I"),U,2)
. S:ICDC]"" CODESTAT=CODESTAT_$S(+$$STATCHK^ICDXCODE(GMPLCPTR,ICDC,GMPINDT):"",1:"#")
. S ICDI=0 F S ICDI=$O(^AUPNPROB(IFN,803,ICDI)) Q:+ICDI'>0 D
.. N ICDM0,ICDMC,ICDMCSYS,ICDMDT,ICDCSPTR
.. S ICDM0=$G(^AUPNPROB(IFN,803,ICDI,0)),ICDMC=$P(ICDM0,U) Q:ICDMC']""
.. S ICDMCSYS=$P(ICDM0,U,2),ICDMDT=$P(ICDM0,U,3),ICDCSPTR=+$$CODECS^ICDEX(ICDMC,80,ICDMDT)
.. S ICDC=ICDC_"/"_ICDMC
.. I CODESTAT'["#" S CODESTAT=CODESTAT_$S(+$$STATCHK^ICDXCODE(ICDCSPTR,ICDMC,GMPINDT):"",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,GMPINDT,,"SCT"):"",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_U_GMPCSYS
. 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLENFM 8540 printed Apr 09, 2024@21:32:33 Page 2
GMPLENFM ; SLC/MKB/KER/TC -- Problem List Enc Form utilities ;06/12/13 09:08
+1 ;;2.0;Problem List;**3,4,7,26,35,36,42**;Aug 25, 1994;Build 46
+2 ;
+3 ; External References
+4 ; DBIA 1609 CONFIG^LEXSET
+5 ; ICR 5699 $$ICDDATA^ICDXCODE, $$STATCHK^ICDXCODE
+6 ; ICR 5747 $$CSI/SAB/CODECS^ICDEX
+7 ; DBIA 10006 ^DIC
+8 ;
ACTIVE ; List of Active Problems for DFN
+1 ; Input variables:
+2 ; DFN Patient ID (Required)
+3 ; [GMPINDT] 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 ; 13: ICD Coding System ("ICD": ICD-9-CM, "10D": ICD-10-CM)
+32 ;
+33 NEW IFN,PROB,CNT,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL
+34 NEW GMPDFN,NODE
+35 if $GET(DFN)'>0
QUIT
SET GMPDFN=DFN
SET CNT=0
SET NODE=$GET(^GMPL(125.99,1,0))
+36 SET GMPINDT=$GET(GMPINDT,$$DT^XLFDT)
+37 SET GMPARAM("VER")=$PIECE(NODE,U,2)
SET GMPARAM("REV")=$PIECE(NODE,U,5)="R"
SET GMPARAM("QUIET")=1
+38 SET GMPLVIEW("ACT")="A"
SET GMPLVIEW("PROV")=0
SET GMPLVIEW("VIEW")=""
+39 DO GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
+40 FOR NUM=0:0
SET NUM=$ORDER(GMPLIST(NUM))
if NUM'>0
QUIT
Begin DoDot:1
+41 NEW GMPL0,GMPL1,GMPL800,GMPL802,GMPCSYS,GMPDT,GMPLCPTR,CODESTAT,ICDC,ICDI,SCTC,SCTD,VHATC,VHATD
+42 SET IFN=GMPLIST(NUM)
if IFN'>0
QUIT
+43 SET GMPL0=$GET(^AUPNPROB(IFN,0))
SET GMPL1=$GET(^(1))
SET GMPL800=$GET(^(800))
SET GMPL802=$GET(^(802))
SET CODESTAT=""
+44 SET GMPDT=$SELECT(+$PIECE(GMPL802,U,1):$PIECE(GMPL802,U,1),1:$PIECE(GMPL0,U,8))
SET GMPLCPTR=$$CSI^ICDEX(80,+GMPL0)
+45 SET GMPCSYS=$SELECT($PIECE(GMPL802,U,2)]"":$PIECE(GMPL802,U,2),1:$$SAB^ICDEX(GMPLCPTR,GMPDT))
+46 SET ICDC=$PIECE($$ICDDATA^ICDXCODE(GMPCSYS,+GMPL0,GMPDT,"I"),U,2)
+47 if ICDC]""
SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^ICDXCODE(GMPLCPTR,ICDC,GMPINDT):"",1:"#")
+48 SET ICDI=0
FOR
SET ICDI=$ORDER(^AUPNPROB(IFN,803,ICDI))
if +ICDI'>0
QUIT
Begin DoDot:2
+49 NEW ICDM0,ICDMC,ICDMCSYS,ICDMDT,ICDCSPTR
+50 SET ICDM0=$GET(^AUPNPROB(IFN,803,ICDI,0))
SET ICDMC=$PIECE(ICDM0,U)
+51 SET ICDMCSYS=$PIECE(ICDM0,U,2)
SET ICDMDT=$PIECE(ICDM0,U,3)
SET ICDCSPTR=+$$CODECS^ICDEX(ICDMC,80,ICDMDT)
+52 SET ICDC=ICDC_"/"_ICDMC
+53 IF CODESTAT'["#"
SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^ICDXCODE(ICDCSPTR,ICDMC,GMPINDT):"",1:"#")
End DoDot:2
+54 SET SCTC=$PIECE(GMPL800,U)
SET SCTD=$PIECE(GMPL800,U,2)
SET VHATC=$PIECE(GMPL800,U,3)
SET VHATD=$PIECE(GMPL800,U,4)
+55 SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^LEXSRC2(SCTC,GMPINDT,,"SCT"):"",1:"$")
+56 SET PROB=$$PROBTEXT^GMPLX(IFN)
SET CNT=CNT+1
+57 IF GMPARAM("VER")
IF $PIECE(GMPL1,U,2)="T"
SET PROB="$"_PROB
+58 SET PROB=PROB_U_ICDC
+59 SET PROB=PROB_U_$$EXTDT^GMPLX($PIECE(GMPL0,U,13))
SET SC=$PIECE(GMPL1,U,10)
+60 SET PROB=PROB_U_$SELECT(+SC:"SC^Y",SC=0:"NSC^N",1:"^")
+61 SET PROB=PROB_U_$$TXFCTR(GMPL1)_U_SCTC_U_SCTD_U_VHATC_U_VHATD_U_CODESTAT_U_GMPCSYS
+62 SET ^TMP("IB",$JOB,"INTERFACES",+$GET(DFN),"GMP PATIENT ACTIVE PROBLEMS",CNT)=PROB
End DoDot:1
+63 SET ^TMP("IB",$JOB,"INTERFACES",+$GET(DFN),"GMP PATIENT ACTIVE PROBLEMS",0)=CNT
+64 QUIT
+65 ;
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("GMPX","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 ; [GMPINDT] 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 ; 14: ICD coding system ("ICD": ICD-9-CM, "10D": ICD-10-CM)
+33 ;
+34 NEW IFN,PROB,CNT,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL,GMPDFN,NODE
+35 if $GET(DFN)'>0
QUIT
SET GMPDFN=DFN
SET CNT=0
SET NODE=$GET(^GMPL(125.99,1,0))
+36 SET GMPINDT=$GET(GMPINDT,$$DT^XLFDT)
+37 SET GMPARAM("VER")=$PIECE(NODE,U,2)
SET GMPARAM("REV")=$PIECE(NODE,U,5)="R"
SET GMPARAM("QUIET")=1
+38 SET GMPLVIEW("ACT")="A"
SET GMPLVIEW("PROV")=0
SET GMPLVIEW("VIEW")=""
+39 DO GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
+40 FOR NUM=0:0
SET NUM=$ORDER(GMPLIST(NUM))
if NUM'>0
QUIT
Begin DoDot:1
+41 NEW GMPL0,GMPL1,GMPL800,GMPL802,GMPDT,GMPCSYS,GMPLCPTR,CODESTAT,ICDC,ICDI,SCTC,SCTD,VHATC,VHATD
+42 SET IFN=GMPLIST(NUM)
if IFN'>0
QUIT
+43 SET GMPL0=$GET(^AUPNPROB(IFN,0))
SET GMPL1=$GET(^(1))
SET GMPL800=$GET(^(800))
SET GMPL802=$GET(^(802))
SET CODESTAT=""
+44 SET GMPDT=$SELECT(+$PIECE(GMPL802,U,1):$PIECE(GMPL802,U,1),1:$PIECE(GMPL0,U,8))
SET GMPLCPTR=$$CSI^ICDEX(80,+GMPL0)
+45 SET GMPCSYS=$SELECT($PIECE(GMPL802,U,2)]"":$PIECE(GMPL802,U,2),1:$$SAB^ICDEX(GMPLCPTR,GMPDT))
+46 SET ICDC=$PIECE($$ICDDATA^ICDXCODE(GMPCSYS,+GMPL0,GMPDT,"I"),U,2)
+47 if ICDC]""
SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^ICDXCODE(GMPLCPTR,ICDC,GMPINDT):"",1:"#")
+48 SET ICDI=0
FOR
SET ICDI=$ORDER(^AUPNPROB(IFN,803,ICDI))
if +ICDI'>0
QUIT
Begin DoDot:2
+49 NEW ICDM0,ICDMC,ICDMCSYS,ICDMDT,ICDCSPTR
+50 SET ICDM0=$GET(^AUPNPROB(IFN,803,ICDI,0))
SET ICDMC=$PIECE(ICDM0,U)
if ICDMC']""
QUIT
+51 SET ICDMCSYS=$PIECE(ICDM0,U,2)
SET ICDMDT=$PIECE(ICDM0,U,3)
SET ICDCSPTR=+$$CODECS^ICDEX(ICDMC,80,ICDMDT)
+52 SET ICDC=ICDC_"/"_ICDMC
+53 IF CODESTAT'["#"
SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^ICDXCODE(ICDCSPTR,ICDMC,GMPINDT):"",1:"#")
End DoDot:2
+54 SET SCTC=$PIECE(GMPL800,U)
SET SCTD=$PIECE(GMPL800,U,2)
SET VHATC=$PIECE(GMPL800,U,3)
SET VHATD=$PIECE(GMPL800,U,4)
+55 if SCTC]""
SET CODESTAT=CODESTAT_$SELECT(+$$STATCHK^LEXSRC2(SCTC,GMPINDT,,"SCT"):"",1:"$")
+56 SET PROB=$$PROBTEXT^GMPLX(IFN)
SET CNT=CNT+1
+57 IF GMPARAM("VER")
IF $PIECE(GMPL1,U,2)="T"
SET PROB="$"_PROB
+58 SET PROB=IFN_U_PROB
+59 SET PROB=PROB_U_ICDC
+60 SET PROB=PROB_U_$$EXTDT^GMPLX($PIECE(GMPL0,U,13))
SET SC=$PIECE(GMPL1,U,10)
+61 SET PROB=PROB_U_$SELECT(+SC:"SC^Y",SC=0:"NSC^N",1:"^")
+62 SET PROB=PROB_U_$$TXFCTR(GMPL1)_U_SCTC_U_SCTD_U_VHATC_U_VHATD_U_CODESTAT_U_GMPCSYS
+63 SET ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",CNT)=PROB
End DoDot:1
+64 SET ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=CNT
+65 QUIT
+66 ;
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
