ORQQPL ; slc/CLA/REV - Functions which return patient problem list data ;12/15/97 [ 23-APR-1999 11:02:10 ]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,10,85,173**;Dec 17, 1997
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,ORICD186
S ORICD186=$$PATCH^XPDUTL("ICD*18.0*6")
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
..S X=ORGMPL(I),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
..I +ORICD186,'+$$STATCHK^ICDAPIU($P(ORPY(I),U,4),DT) D
...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,GMPDT
I $L($T(DETAIL^GMPLUTL2))>0 D
.D DETAIL^GMPLUTL2(PROBIEN,.ORGMPL)
.N CR,I,J S CR=$CHAR(13),I=1
.S Y(I)=ORGMPL("NARRATIVE")_" ("_ORGMPL("DIAGNOSIS")_")",I=I+1
.I $$PATCH^XPDUTL("ICD*18.0*6"),'+$$STATCHK^ICDAPIU(ORGMPL("DIAGNOSIS"),DT) D
..S Y(I)="*** The ICD code "_ORGMPL("DIAGNOSIS")_" is currently inactive. ***",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
ORQQPL ; slc/CLA/REV - Functions which return patient problem list data ;12/15/97 [ 23-APR-1999 11:02:10 ]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,10,85,173**;Dec 17, 1997
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,ORICD186
+5 SET ORICD186=$$PATCH^XPDUTL("ICD*18.0*6")
+6 IF $LENGTH($TEXT(LIST^GMPLUTL2))>0
Begin DoDot:1
+7 DO LIST^GMPLUTL2(.ORGMPL,DFN,STATUS)
+8 IF '$DATA(ORGMPL(0))
QUIT
+9 SET DETAIL=$$DETAIL^ORWCV1(10)
+10 FOR I=1:1:ORGMPL(0)
Begin DoDot:2
+11 SET X=ORGMPL(I)
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
+12 IF +ORICD186
IF '+$$STATCHK^ICDAPIU($PIECE(ORPY(I),U,4),DT)
Begin DoDot:3
+13 SET $PIECE(ORPY(I),U,13)="#"
SET $PIECE(ORPY(I),U,9)="#"
End DoDot:3
End DoDot:2
+14 IF +$GET(ORPY(1))<1
SET ORPY(1)="^No problems found."
End DoDot:1
+15 IF $LENGTH($TEXT(LIST^GMPLUTL2))<1
SET ORPY(1)="^Problem list not available.^"
+16 KILL X
+17 QUIT
DETAIL(Y,DFN,PROBIEN,ID) ; RETURN DETAILED PROBLEM DATA
+1 NEW ORGMPL,GMPDT
+2 IF $LENGTH($TEXT(DETAIL^GMPLUTL2))>0
Begin DoDot:1
+3 DO DETAIL^GMPLUTL2(PROBIEN,.ORGMPL)
+4 NEW CR,I,J
SET CR=$CHAR(13)
SET I=1
+5 SET Y(I)=ORGMPL("NARRATIVE")_" ("_ORGMPL("DIAGNOSIS")_")"
SET I=I+1
+6 IF $$PATCH^XPDUTL("ICD*18.0*6")
IF '+$$STATCHK^ICDAPIU(ORGMPL("DIAGNOSIS"),DT)
Begin DoDot:2
+7 SET Y(I)="*** The ICD code "_ORGMPL("DIAGNOSIS")_" is currently inactive. ***"
SET I=I+1
End DoDot:2
+8 SET Y(I)=" "
SET I=I+1
+9 SET Y(I)=" Onset: "_ORGMPL("ONSET")
SET I=I+1
+10 SET Y(I)=" Status: "_ORGMPL("STATUS")
+11 SET Y(I)=Y(I)_$SELECT(ORGMPL("PRIORITY")="ACUTE":"/ACUTE",ORGMPL("PRIORITY")="CHRONIC":"/CHRONIC",1:"")
SET I=I+1
+12 SET Y(I)=" SC Cond: "_ORGMPL("SC")
SET I=I+1
+13 SET Y(I)="Exposure: "_$SELECT($GET(ORGMPL("EXPOSURE"))>0:ORGMPL("EXPOSURE",1),1:"None")
SET I=I+1
+14 IF $GET(ORGMPL("EXPOSURE"))>1
FOR J=2:1:ORGMPL("EXPOSURE")
Begin DoDot:2
+15 SET Y(I)=" "_ORGMPL("EXPOSURE",J)
SET I=I+1
End DoDot:2
+16 SET Y(I)=" "
SET I=I+1
+17 SET Y(I)="Provider: "_ORGMPL("PROVIDER")
SET I=I+1
+18 SET Y(I)=" Clinic: "_ORGMPL("CLINIC")
SET I=I+1
+19 SET Y(I)=" "
SET I=I+1
+20 SET Y(I)="Recorded: "_$PIECE(ORGMPL("RECORDED"),U)_", by "_$PIECE(ORGMPL("RECORDED"),U,2)
SET I=I+1
+21 SET Y(I)=" Entered: "_$PIECE(ORGMPL("ENTERED"),U)_", by "_$PIECE(ORGMPL("ENTERED"),U,2)
SET I=I+1
+22 SET Y(I)=" Updated: "_ORGMPL("MODIFIED")
SET I=I+1
+23 SET Y(I)=" "
SET I=I+1
+24 ;S Y(I)=" Comment: "_$S($G(ORGMPL("COMMENT"))>0:ORGMPL("COMMENT"),1:"")
+25 IF $GET(ORGMPL("COMMENT"))>0
Begin DoDot:2
+26 SET Y(I)="----------- Comments -----------"
SET I=I+1
+27 ;F J=ORGMPL("COMMENT"):-1:1 D
+28 ;.S Y(I)=ORGMPL("COMMENT",J)
+29 ;.S Y(I)=$P(Y(I),U)_" by "_$P(Y(I),U,2)_": "_$P(Y(I),U,3),I=I+1
+30 FOR J=1:1:ORGMPL("COMMENT")
Begin DoDot:3
+31 SET Y(I)=ORGMPL("COMMENT",J)
+32 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
+33 SET Y(I)=" "
SET I=I+1
+34 DO HIST^ORQQPL2(.GMPDT,PROBIEN)
+35 IF $GET(GMPDT(0))>0
Begin DoDot:2
+36 SET Y(I)="----------- Audit History -----------"
SET I=I+1
+37 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
+38 IF $LENGTH($TEXT(DETAIL^GMPLUTL2))<1
SET Y(1)="Problem list not available."
+39 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
