update to Procedure extract to avoid ICOM problem

This commit is contained in:
george 2010-01-25 22:20:52 +00:00
parent 14e52bc5d1
commit 0d4e8bbd71
1 changed files with 1 additions and 7 deletions

View File

@ -59,11 +59,6 @@ VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
.. S ILST=ILST+1 .. S ILST=ILST+1
.. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
.. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV
.. I X811]"" D
... S ICOM=ICOM+1
... S $P(LST(ILST),U,10)=ICOM
... S ILST=ILST+1
... S LST(ILST)="COM"_U_ICOM_U_X811
. S ICPT=0 F S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT D . S ICPT=0 F S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT D
.. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811)) .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
.. ;S CODE=$P(X0,U) .. ;S CODE=$P(X0,U)
@ -88,9 +83,8 @@ VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
Q Q
GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT
;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT" ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT"
;Q:'$D(VISIT(IEN,"CPT")) Q:'$D(VISIT(IEN,"CPT"))
S TXTCNT=0 S TXTCNT=0
F S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0)) D F S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0)) D
. S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0) . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0)
Q Q