- 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 Feb 19, 2025@00:00:11 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