ORQQPL ; ISL/CLA,REV,JER,TC - RPCs to return problem list data ;11/20/14 13:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,10,85,173,306,361,385,350**;Dec 17, 1997;Build 77
;
; External References:
; $$CODECS^ICDEX ICR #5747
; $$STATCHK^ICDXCODE ICR #5699
; $$STATCHK^LEXSRC2 ICR #4083
;
LIST(ORPY,DFN,STATUS) ;return pt's problem list in format: ien^description^
; ICD^onset^last modified^SC^SpExp
; STATUS = status of problems to return: (A)CTIVE, (I)NACTIVE, ("")ALL
Q:'+DFN
N ORGMPL,I,DETAIL,ORIDT,IMPLDT
S IMPLDT=$$IMPDATE^LEXU("10D")
S ORIDT=$S($P(DFN,U,2)]"":$P(DFN,U,2),1:DT)
S:ORIDT'>0 ORIDT=DT
S DFN=+DFN
I $L($T(LIST^GMPLUTL2))>0 D
.D LIST^GMPLUTL2(.ORGMPL,DFN,STATUS)
.Q:'$D(ORGMPL(0))
.S DETAIL=$$DETAIL^ORWCV1(10)
.F I=1:1:ORGMPL(0) D
..N LEX,X
..S X=ORGMPL(I)
..S ORPY(I)=$P(X,U)_U_$P(X,U,3)_U_$P(X,U,2)_U_$P(X,U,4)_U_$P(X,U,5)_U_$P(X,U,6)_U_$P(X,U,7)_U_$P(X,U,8)_U_$P(X,U,10)_U_$P(X,U,9)_U_U_DETAIL_U_U_$P(X,U,11)_U_$P(X,U,12)_U_$P(X,U,13)
..S ORPY(I)=ORPY(I)_U_$S($P(ORPY(I),U,2)?.U1" "1"-"1" ".E:1,1:"")
..I (ORIDT<IMPLDT),(+$$STATCHK^ICDXCODE($P(ORPY(I),U,16),$P(ORPY(I),U,4),ORIDT)'=1) D I 1
...S $P(ORPY(I),U,13)="#",$P(ORPY(I),U,9)="#"
..E I $L($P(ORPY(I),U,14)),(+$$STATCHK^LEXSRC2($P(ORPY(I),U,14),ORIDT,.LEX)'=1) S $P(ORPY(I),U,13)="$",$P(ORPY(I),U,9)="#"
.S:+$G(ORPY(1))<1 ORPY(1)="^No problems found."
I $L($T(LIST^GMPLUTL2))<1 S ORPY(1)="^Problem list not available.^"
K X
Q
DETAIL(Y,DFN,PROBIEN,ID) ; RETURN DETAILED PROBLEM DATA
N ORGMPL,ORIDT,GMPDT,ORICDLBL
S ORIDT=$S($P(DFN,U,2)]"":$P(DFN,U,2),1:DT)
S DFN=+DFN
S:ORIDT'>0 ORIDT=DT
I $L($T(DETAIL^GMPLUTL2))>0 D
.N CR,I,J,T,LEX S CR=$CHAR(13),I=1
.D DETAIL^GMPLUTL2(PROBIEN,.ORGMPL)
.S ORICDLBL=$P($$CODECS^ICDEX(ORGMPL("DIAGNOSIS"),80,ORGMPL("DTINTEREST")),U,2)
.S Y(I)=ORGMPL("NARRATIVE"),I=I+1
.I '+$$STATCHK^ICDXCODE(ORGMPL("CSYS"),ORGMPL("DIAGNOSIS"),ORIDT) D I 1
..S Y(I)="*** The "_ORICDLBL_" code "_ORGMPL("DIAGNOSIS")_" is currently inactive. ***",I=I+1
.I +$G(ORGMPL("SCTC")),(+$$STATCHK^LEXSRC2($G(ORGMPL("SCTC")),ORIDT,.LEX)'=1) D
..S Y(I)="*** The SNOMED-CT code "_ORGMPL("SCTC")_" is currently inactive. ***",I=I+1
.I $L($G(ORGMPL("SCTC")))!$L($G(ORGMPL("SCTD"))) D I 1
..I $P(ORGMPL("NARRATIVE")," (SCT")'=ORGMPL("SCTT") S Y(I)=" SNOMED-CT: "_ORGMPL("SCTT"),I=I+1
..I $L($G(ORGMPL("DIAGNOSIS")))&$L($G(ORGMPL("ICDD"))) S Y(I)=$S(ORGMPL("CSYS")="10D":" Primary ",1:" Primary ")_ORICDLBL_": "_$G(ORGMPL("DIAGNOSIS"))_$$PAD^ORUTL($G(ORGMPL("DIAGNOSIS")),6)_" ["_$G(ORGMPL("ICDD"))_"]",I=I+1
.E I $L($G(ORGMPL("ICDD"))) D
..N ICDD,J S ICDD=$$WRAP^ORU2($G(ORGMPL("ICDD")),65)
..F J=1:1:$L(ICDD,"|") S Y(I)=$S(J=1:ORICDLBL_" TEXT: ",1:" ")_$P(ICDD,"|",J),I=I+1
.I ORGMPL("ICD9MLTP")'="" F T=1:1:ORGMPL("ICD9MLTP") D
..N ORMELBL S ORMELBL=$S($P($G(ORGMPL("ICD9MLTP",T)),U,3)="10D":"ICD-10-CM",1:"ICD-9-CM")
..S Y(I)=$S(T=1:"Secondary "_ORMELBL_": ",T>1:" : ")_$P($G(ORGMPL("ICD9MLTP",T)),U)_$$PAD^ORUTL($P($G(ORGMPL("ICD9MLTP",T)),U),6)_" ["_$P($G(ORGMPL("ICD9MLTP",T)),U,2)_"]",I=I+1
.S Y(I)=" ",I=I+1
.S Y(I)=" Onset: "_ORGMPL("ONSET"),I=I+1
.S Y(I)=" Status: "_ORGMPL("STATUS")
.S Y(I)=Y(I)_$S(ORGMPL("PRIORITY")="ACUTE":"/ACUTE",ORGMPL("PRIORITY")="CHRONIC":"/CHRONIC",1:""),I=I+1
.S Y(I)=" SC Cond: "_ORGMPL("SC"),I=I+1
.S Y(I)=" Exposure: "_$S($G(ORGMPL("EXPOSURE"))>0:ORGMPL("EXPOSURE",1),1:"None"),I=I+1
.I $G(ORGMPL("EXPOSURE"))>1 F J=2:1:ORGMPL("EXPOSURE") D
..S Y(I)=" "_ORGMPL("EXPOSURE",J),I=I+1
.S Y(I)=" ",I=I+1
.S Y(I)=" Provider: "_ORGMPL("PROVIDER"),I=I+1
.S Y(I)=" Clinic: "_ORGMPL("CLINIC"),I=I+1
.S Y(I)=" ",I=I+1
.S Y(I)=" Recorded: "_$P(ORGMPL("RECORDED"),U)_", by "_$P(ORGMPL("RECORDED"),U,2),I=I+1
.S Y(I)=" Entered: "_$P(ORGMPL("ENTERED"),U)_", by "_$P(ORGMPL("ENTERED"),U,2),I=I+1
.S Y(I)=" Updated: "_ORGMPL("MODIFIED"),I=I+1
.S Y(I)=" ",I=I+1
.;S Y(I)=" Comment: "_$S($G(ORGMPL("COMMENT"))>0:ORGMPL("COMMENT"),1:"")
.I $G(ORGMPL("COMMENT"))>0 D
..S Y(I)="----------- Comments -----------",I=I+1
..;F J=ORGMPL("COMMENT"):-1:1 D
..;.S Y(I)=ORGMPL("COMMENT",J)
..;.S Y(I)=$P(Y(I),U)_" by "_$P(Y(I),U,2)_": "_$P(Y(I),U,3),I=I+1
..F J=1:1:ORGMPL("COMMENT") D
...S Y(I)=ORGMPL("COMMENT",J)
...S Y(I)=$P(Y(I),U)_" by "_$P(Y(I),U,2)_": "_$P(Y(I),U,3),I=I+1
.S Y(I)=" ",I=I+1
.D HIST^ORQQPL2(.GMPDT,PROBIEN)
.I $G(GMPDT(0))>0 D
..S Y(I)="----------- Audit History -----------",I=I+1
..F J=1:1:GMPDT(0) S Y(I)=$P(GMPDT(J),U)_": "_$P(GMPDT(J),U,2),I=I+1
I $L($T(DETAIL^GMPLUTL2))<1 S Y(1)="Problem list not available."
Q
HASPROB(ORDFN,ORPROB) ;extrinsic function returns 1^problem text;ICD9 if
;pt has an active problem which contains any piece of ORPROB
;ORDFN patient DFN
;ORPROB problems to check vs. active prob list in format: PROB1TEXT;PROB1ICD^PROB2TEXT;PROB2ICD^PROB3...
;if ICD includes "." an exact match will be sought
;if not, a match of general ICD category will be sought
;Note: All ICD codes passed must be preceded with ";"
Q:+$G(ORDFN)<1 "0^Patient not identified."
Q:'$L($G(ORPROB)) "0^Problem not identified."
N ORQAPL,ORQY,ORI,ORJ,ORCNT,ORQPL,ORQICD,ORQRSLT
D LIST(.ORQY,ORDFN,"A")
Q:$P(ORQY(1),U)="" "0^No active problems found."
S ORQRSLT="0^No matching problems found."
S ORCNT=$L(ORPROB,U)
S ORI=0 F S ORI=$O(ORQY(ORI)) Q:ORI<1 D
.S ORQAPL=ORQY(ORI)
.F ORJ=1:1:ORCNT D
..S ORQPL=$P($P(ORPROB,U,ORJ),";"),ORQICD=$P($P(ORPROB,U,ORJ),";",2)
..;if problem text and pt's problem contains problem text passed:
..I $L(ORQPL),($P(ORQAPL,U,2)[ORQPL) D
...S ORQRSLT="1^"_$P(ORQAPL,U,2)_";"_$P(ORQAPL,U,4)
..;
..;if specific ICD (contains ".") and pt's ICD equals ICD passed:
..I $L(ORQICD),(ORQICD["."),($P(ORQAPL,U,4)=ORQICD) D
...S ORQRSLT="1^"_$P(ORQAPL,U,2)_";"_$P(ORQAPL,U,4)
..;
..;if non-specific ICD and pt's ICD category equals ICD category passed:
..I $L(ORQICD),(ORQICD'["."),($P($P(ORQAPL,U,4),".")=ORQICD) D
...S ORQRSLT="1^"_$P(ORQAPL,U,2)_";"_$P(ORQAPL,U,4)
Q ORQRSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQQPL 6174 printed Apr 09, 2024@21:43:35 Page 2
ORQQPL ; ISL/CLA,REV,JER,TC - RPCs to return problem list data ;11/20/14 13:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,10,85,173,306,361,385,350**;Dec 17, 1997;Build 77
+2 ;
+3 ; External References:
+4 ; $$CODECS^ICDEX ICR #5747
+5 ; $$STATCHK^ICDXCODE ICR #5699
+6 ; $$STATCHK^LEXSRC2 ICR #4083
+7 ;
LIST(ORPY,DFN,STATUS) ;return pt's problem list in format: ien^description^
+1 ; ICD^onset^last modified^SC^SpExp
+2 ; STATUS = status of problems to return: (A)CTIVE, (I)NACTIVE, ("")ALL
+3 if '+DFN
QUIT
+4 NEW ORGMPL,I,DETAIL,ORIDT,IMPLDT
+5 SET IMPLDT=$$IMPDATE^LEXU("10D")
+6 SET ORIDT=$SELECT($PIECE(DFN,U,2)]"":$PIECE(DFN,U,2),1:DT)
+7 if ORIDT'>0
SET ORIDT=DT
+8 SET DFN=+DFN
+9 IF $LENGTH($TEXT(LIST^GMPLUTL2))>0
Begin DoDot:1
+10 DO LIST^GMPLUTL2(.ORGMPL,DFN,STATUS)
+11 if '$DATA(ORGMPL(0))
QUIT
+12 SET DETAIL=$$DETAIL^ORWCV1(10)
+13 FOR I=1:1:ORGMPL(0)
Begin DoDot:2
+14 NEW LEX,X
+15 SET X=ORGMPL(I)
+16 SET ORPY(I)=$PIECE(X,U)_U_$PIECE(X,U,3)_U_$PIECE(X,U,2)_U_$PIECE(X,U,4)_U_$PIECE(X,U,5)_U_$PIECE(X,U,6)_U_$PIECE(X,U,7)_U_$PIECE(X,U,8)_U_$PIECE(X,U,10)_U_$PIECE(X,U,9)_U_U_DETAIL_U_U_$PIECE(X,U,11)_U_$PIECE(X,U,12)_U_$PIECE(X,U
,13)
+17 SET ORPY(I)=ORPY(I)_U_$SELECT($PIECE(ORPY(I),U,2)?.U1" "1"-"1" ".E:1,1:"")
+18 IF (ORIDT<IMPLDT)
IF (+$$STATCHK^ICDXCODE($PIECE(ORPY(I),U,16),$PIECE(ORPY(I),U,4),ORIDT)'=1)
Begin DoDot:3
+19 SET $PIECE(ORPY(I),U,13)="#"
SET $PIECE(ORPY(I),U,9)="#"
End DoDot:3
IF 1
+20 IF '$TEST
IF $LENGTH($PIECE(ORPY(I),U,14))
IF (+$$STATCHK^LEXSRC2($PIECE(ORPY(I),U,14),ORIDT,.LEX)'=1)
SET $PIECE(ORPY(I),U,13)="$"
SET $PIECE(ORPY(I),U,9)="#"
End DoDot:2
+21 if +$GET(ORPY(1))<1
SET ORPY(1)="^No problems found."
End DoDot:1
+22 IF $LENGTH($TEXT(LIST^GMPLUTL2))<1
SET ORPY(1)="^Problem list not available.^"
+23 KILL X
+24 QUIT
DETAIL(Y,DFN,PROBIEN,ID) ; RETURN DETAILED PROBLEM DATA
+1 NEW ORGMPL,ORIDT,GMPDT,ORICDLBL
+2 SET ORIDT=$SELECT($PIECE(DFN,U,2)]"":$PIECE(DFN,U,2),1:DT)
+3 SET DFN=+DFN
+4 if ORIDT'>0
SET ORIDT=DT
+5 IF $LENGTH($TEXT(DETAIL^GMPLUTL2))>0
Begin DoDot:1
+6 NEW CR,I,J,T,LEX
SET CR=$CHAR(13)
SET I=1
+7 DO DETAIL^GMPLUTL2(PROBIEN,.ORGMPL)
+8 SET ORICDLBL=$PIECE($$CODECS^ICDEX(ORGMPL("DIAGNOSIS"),80,ORGMPL("DTINTEREST")),U,2)
+9 SET Y(I)=ORGMPL("NARRATIVE")
SET I=I+1
+10 IF '+$$STATCHK^ICDXCODE(ORGMPL("CSYS"),ORGMPL("DIAGNOSIS"),ORIDT)
Begin DoDot:2
+11 SET Y(I)="*** The "_ORICDLBL_" code "_ORGMPL("DIAGNOSIS")_" is currently inactive. ***"
SET I=I+1
End DoDot:2
IF 1
+12 IF +$GET(ORGMPL("SCTC"))
IF (+$$STATCHK^LEXSRC2($GET(ORGMPL("SCTC")),ORIDT,.LEX)'=1)
Begin DoDot:2
+13 SET Y(I)="*** The SNOMED-CT code "_ORGMPL("SCTC")_" is currently inactive. ***"
SET I=I+1
End DoDot:2
+14 IF $LENGTH($GET(ORGMPL("SCTC")))!$LENGTH($GET(ORGMPL("SCTD")))
Begin DoDot:2
+15 IF $PIECE(ORGMPL("NARRATIVE")," (SCT")'=ORGMPL("SCTT")
SET Y(I)=" SNOMED-CT: "_ORGMPL("SCTT")
SET I=I+1
+16 IF $LENGTH($GET(ORGMPL("DIAGNOSIS")))&$LENGTH($GET(ORGMPL("ICDD")))
SET Y(I)=$SELECT(ORGMPL("CSYS")="10D":" Primary ",1:" Primary ")_ORICDLBL_": "_$GET(ORGMPL("DIAGNOSIS"))_$$PAD^ORUTL($GET(ORGMPL("DIAGNOSIS")),6)_" ["_$GET(ORGMPL("ICDD"))_"]"
SET I=I+1
End DoDot:2
IF 1
+17 IF '$TEST
IF $LENGTH($GET(ORGMPL("ICDD")))
Begin DoDot:2
+18 NEW ICDD,J
SET ICDD=$$WRAP^ORU2($GET(ORGMPL("ICDD")),65)
+19 FOR J=1:1:$LENGTH(ICDD,"|")
SET Y(I)=$SELECT(J=1:ORICDLBL_" TEXT: ",1:" ")_$PIECE(ICDD,"|",J)
SET I=I+1
End DoDot:2
+20 IF ORGMPL("ICD9MLTP")'=""
FOR T=1:1:ORGMPL("ICD9MLTP")
Begin DoDot:2
+21 NEW ORMELBL
SET ORMELBL=$SELECT($PIECE($GET(ORGMPL("ICD9MLTP",T)),U,3)="10D":"ICD-10-CM",1:"ICD-9-CM")
+22 SET Y(I)=$SELECT(T=1:"Secondary "_ORMELBL_": ",T>1:" : ")_$PIECE($GET(ORGMPL("ICD9MLTP",T)),U)_$$PAD^ORUTL($PIECE($GET(ORGMPL("ICD9MLTP",T)),U),6)_" ["_$PIECE($GET(ORGMPL("ICD9MLTP",T)),U,2)_"]"
SET I=I+1
End DoDot:2
+23 SET Y(I)=" "
SET I=I+1
+24 SET Y(I)=" Onset: "_ORGMPL("ONSET")
SET I=I+1
+25 SET Y(I)=" Status: "_ORGMPL("STATUS")
+26 SET Y(I)=Y(I)_$SELECT(ORGMPL("PRIORITY")="ACUTE":"/ACUTE",ORGMPL("PRIORITY")="CHRONIC":"/CHRONIC",1:"")
SET I=I+1
+27 SET Y(I)=" SC Cond: "_ORGMPL("SC")
SET I=I+1
+28 SET Y(I)=" Exposure: "_$SELECT($GET(ORGMPL("EXPOSURE"))>0:ORGMPL("EXPOSURE",1),1:"None")
SET I=I+1
+29 IF $GET(ORGMPL("EXPOSURE"))>1
FOR J=2:1:ORGMPL("EXPOSURE")
Begin DoDot:2
+30 SET Y(I)=" "_ORGMPL("EXPOSURE",J)
SET I=I+1
End DoDot:2
+31 SET Y(I)=" "
SET I=I+1
+32 SET Y(I)=" Provider: "_ORGMPL("PROVIDER")
SET I=I+1
+33 SET Y(I)=" Clinic: "_ORGMPL("CLINIC")
SET I=I+1
+34 SET Y(I)=" "
SET I=I+1
+35 SET Y(I)=" Recorded: "_$PIECE(ORGMPL("RECORDED"),U)_", by "_$PIECE(ORGMPL("RECORDED"),U,2)
SET I=I+1
+36 SET Y(I)=" Entered: "_$PIECE(ORGMPL("ENTERED"),U)_", by "_$PIECE(ORGMPL("ENTERED"),U,2)
SET I=I+1
+37 SET Y(I)=" Updated: "_ORGMPL("MODIFIED")
SET I=I+1
+38 SET Y(I)=" "
SET I=I+1
+39 ;S Y(I)=" Comment: "_$S($G(ORGMPL("COMMENT"))>0:ORGMPL("COMMENT"),1:"")
+40 IF $GET(ORGMPL("COMMENT"))>0
Begin DoDot:2
+41 SET Y(I)="----------- Comments -----------"
SET I=I+1
+42 ;F J=ORGMPL("COMMENT"):-1:1 D
+43 ;.S Y(I)=ORGMPL("COMMENT",J)
+44 ;.S Y(I)=$P(Y(I),U)_" by "_$P(Y(I),U,2)_": "_$P(Y(I),U,3),I=I+1
+45 FOR J=1:1:ORGMPL("COMMENT")
Begin DoDot:3
+46 SET Y(I)=ORGMPL("COMMENT",J)
+47 SET Y(I)=$PIECE(Y(I),U)_" by "_$PIECE(Y(I),U,2)_": "_$PIECE(Y(I),U,3)
SET I=I+1
End DoDot:3
End DoDot:2
+48 SET Y(I)=" "
SET I=I+1
+49 DO HIST^ORQQPL2(.GMPDT,PROBIEN)
+50 IF $GET(GMPDT(0))>0
Begin DoDot:2
+51 SET Y(I)="----------- Audit History -----------"
SET I=I+1
+52 FOR J=1:1:GMPDT(0)
SET Y(I)=$PIECE(GMPDT(J),U)_": "_$PIECE(GMPDT(J),U,2)
SET I=I+1
End DoDot:2
End DoDot:1
+53 IF $LENGTH($TEXT(DETAIL^GMPLUTL2))<1
SET Y(1)="Problem list not available."
+54 QUIT
HASPROB(ORDFN,ORPROB) ;extrinsic function returns 1^problem text;ICD9 if
+1 ;pt has an active problem which contains any piece of ORPROB
+2 ;ORDFN patient DFN
+3 ;ORPROB problems to check vs. active prob list in format: PROB1TEXT;PROB1ICD^PROB2TEXT;PROB2ICD^PROB3...
+4 ;if ICD includes "." an exact match will be sought
+5 ;if not, a match of general ICD category will be sought
+6 ;Note: All ICD codes passed must be preceded with ";"
+7 if +$GET(ORDFN)<1
QUIT "0^Patient not identified."
+8 if '$LENGTH($GET(ORPROB))
QUIT "0^Problem not identified."
+9 NEW ORQAPL,ORQY,ORI,ORJ,ORCNT,ORQPL,ORQICD,ORQRSLT
+10 DO LIST(.ORQY,ORDFN,"A")
+11 if $PIECE(ORQY(1),U)=""
QUIT "0^No active problems found."
+12 SET ORQRSLT="0^No matching problems found."
+13 SET ORCNT=$LENGTH(ORPROB,U)
+14 SET ORI=0
FOR
SET ORI=$ORDER(ORQY(ORI))
if ORI<1
QUIT
Begin DoDot:1
+15 SET ORQAPL=ORQY(ORI)
+16 FOR ORJ=1:1:ORCNT
Begin DoDot:2
+17 SET ORQPL=$PIECE($PIECE(ORPROB,U,ORJ),";")
SET ORQICD=$PIECE($PIECE(ORPROB,U,ORJ),";",2)
+18 ;if problem text and pt's problem contains problem text passed:
+19 IF $LENGTH(ORQPL)
IF ($PIECE(ORQAPL,U,2)[ORQPL)
Begin DoDot:3
+20 SET ORQRSLT="1^"_$PIECE(ORQAPL,U,2)_";"_$PIECE(ORQAPL,U,4)
End DoDot:3
+21 ;
+22 ;if specific ICD (contains ".") and pt's ICD equals ICD passed:
+23 IF $LENGTH(ORQICD)
IF (ORQICD[".")
IF ($PIECE(ORQAPL,U,4)=ORQICD)
Begin DoDot:3
+24 SET ORQRSLT="1^"_$PIECE(ORQAPL,U,2)_";"_$PIECE(ORQAPL,U,4)
End DoDot:3
+25 ;
+26 ;if non-specific ICD and pt's ICD category equals ICD category passed:
+27 IF $LENGTH(ORQICD)
IF (ORQICD'[".")
IF ($PIECE($PIECE(ORQAPL,U,4),".")=ORQICD)
Begin DoDot:3
+28 SET ORQRSLT="1^"_$PIECE(ORQAPL,U,2)_";"_$PIECE(ORQAPL,U,4)
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT ORQRSLT
