Routine: ORQQPL

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

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."

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

ORQQPL.m