Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VPRDSR

VPRDSR.m

Go to the documentation of this file.
  1. VPRDSR ;SLC/MKB -- Surgical Procedures ;8/2/11 15:29
  1. ;;1.0;VIRTUAL PATIENT RECORD;**1,5**;Sep 01, 2011;Build 21
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^SRF(130 5675
  1. ; ^SRO(136 4872
  1. ; DIQ 2056
  1. ; ICPTCOD 1995
  1. ; ICPTMOD 1996
  1. ; SROESTV 3533
  1. ;
  1. ; ------------ Get surgery(ies) from VistA ------------
  1. ;
  1. EN(DFN,BEG,END,MAX,ID) ; -- find patient's surgeries
  1. N VPRN,VPRCNT,VPRITM,VPRY
  1. S DFN=+$G(DFN) Q:DFN<1
  1. S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
  1. ;
  1. ; get one surgery
  1. I $G(ID) D EN1(ID,.VPRITM),XML(.VPRITM) G ENQ
  1. ;
  1. ; get all surgeries
  1. Q:'$L($T(LIST^SROESTV))
  1. N SHOWADD S SHOWADD=1 ;to omit leading '+' with note titles
  1. D LIST^SROESTV(.VPRY,DFN,BEG,END,MAX,1)
  1. S VPRN=0 F S VPRN=$O(@VPRY@(VPRN)) Q:VPRN<1 D
  1. . K VPRITM D ONE(VPRN,.VPRITM)
  1. . I $D(VPRITM) D XML(.VPRITM)
  1. K @VPRY
  1. ENQ ; end
  1. K ^TMP("VPRTEXT",$J)
  1. Q
  1. ;
  1. ONE(NUM,SURG) ; -- return a surgery in SURG("attribute")=value
  1. ; Expects DFN, @VPRY@(NUM) from LIST^SROESTV
  1. N IEN,VPRX,X,Y,I,VPRMOD,VPROTH
  1. K SURG,^TMP("VPRTEXT",$J)
  1. S VPRX=$G(@VPRY@(NUM)),IEN=+$P(VPRX,U) Q:IEN<1
  1. S SURG("id")=IEN,X=$P(VPRX,U,2),SURG("status")="COMPLETED"
  1. I X?1"* Aborted * ".E S X=$E(X,13,999),SURG("status")="ABORTED"
  1. S SURG("name")=X,SURG("dateTime")=$P(VPRX,U,3)
  1. S X=$P(VPRX,U,4) S:X SURG("provider")=$TR(X,";","^")_U_$$PROVSPC^VPRD(+X)
  1. S X=$$GET1^DIQ(130,IEN_",",50,"I"),SURG("facility")=$$FAC^VPRD(X)
  1. S SURG("encounter")=$$GET1^DIQ(130,IEN_",",.015,"I")
  1. S X=$$GET1^DIQ(136,IEN_",",.02,"I") I X D
  1. . S SURG("type")=$$CPT(X)
  1. . D GETS^DIQ(136,IEN_",","1*","I","VPRMOD") ;CPT modifiers
  1. . S I="" F S I=$O(VPRMOD(136.01,I)) Q:I="" D
  1. .. S X=+$G(VPRMOD(136.01,I,.01,"I")),Y=$$MOD^ICPTMOD(X,"I")
  1. .. S SURG("modifier",+I)=$P(Y,U,2,3)
  1. D GETS^DIQ(136,IEN_",","3*","I","VPROTH") ;other procedures
  1. S I="" F S I=$O(VPROTH(136.03,I)) Q:I="" D
  1. . S X=+$G(VPROTH(136.03,I,.01,"I")) Q:'X
  1. . S SURG("otherProcedure",+I)=$$CPT(X)
  1. S I=0 F S I=$O(@VPRY@(NUM,I)) Q:I<1 S X=$G(@VPRY@(NUM,I)) I X D
  1. . S Y=$$INFO^VPRDTIU(+X) Q:Y<1 ;draft or retracted
  1. . S SURG("document",I)=Y
  1. . S:$G(VPRTEXT) SURG("document",I,"content")=$$TEXT^VPRDTIU(+X)
  1. . I Y["OPERATION REPORT"!(Y["PROCEDURE REPORT") S SURG("opReport")=Y
  1. S SURG("category")="SR"
  1. Q
  1. ;
  1. EN1(IEN,SURG) ; -- return a surgery in SURG("attribute")=value
  1. N VPRX,VPRY,X,Y,I,VPRMOD,VPROTH,SHOWADD
  1. K SURG,^TMP("VPRTEXT",$J)
  1. S SHOWADD=1 ;to omit leading '+' with note titles
  1. D ONE^SROESTV("VPRY",IEN) S VPRX=$G(VPRY(IEN)) Q:VPRX=""
  1. S SURG("id")=IEN,X=$P(VPRX,U,2),SURG("status")="COMPLETED"
  1. I X?1"* Aborted * ".E S X=$E(X,13,999),SURG("status")="ABORTED"
  1. S SURG("name")=X,SURG("dateTime")=$P(VPRX,U,3)
  1. S X=$P(VPRX,U,4) S:X SURG("provider")=$TR(X,";","^")_U_$$PROVSPC^VPRD(+X)
  1. S X=$$GET1^DIQ(130,IEN_",",50,"I"),SURG("facility")=$$FAC^VPRD(X)
  1. S SURG("encounter")=$$GET1^DIQ(130,IEN_",",.015,"I")
  1. S X=$$GET1^DIQ(136,IEN_",",.02,"I") I X D
  1. . S SURG("type")=$$CPT(X)
  1. . D GETS^DIQ(136,IEN_",","1*","I","VPRMOD") ;CPT modifiers
  1. . S I="" F S I=$O(VPRMOD(136.01,I)) Q:I="" D
  1. .. S X=+$G(VPRMOD(136.01,I,.01,"I")),Y=$$MOD^ICPTMOD(X,"I")
  1. .. S SURG("modifier",+I)=$P(Y,U,2,3)
  1. D GETS^DIQ(136,IEN_",","3*","I","VPROTH") ;other procedures
  1. S I="" F S I=$O(VPROTH(136.03,I)) Q:I="" D
  1. . S X=+$G(VPROTH(136.03,I,.01,"I")) Q:'X
  1. . S SURG("otherProcedure",+I)=$$CPT(X)
  1. S I=0 F S I=$O(VPRY(IEN,I)) Q:I<1 S X=$G(VPRY(IEN,I)) I X D
  1. . S Y=$$INFO^VPRDTIU(+X) Q:Y<1 ;draft or retracted
  1. . S SURG("document",I)=Y
  1. . S:$G(VPRTEXT) SURG("document",I,"content")=$$TEXT^VPRDTIU(+X)
  1. . I Y["OPERATION REPORT"!(Y["PROCEDURE REPORT") S SURG("opReport")=Y
  1. S SURG("category")="SR"
  1. Q
  1. ;
  1. CPT(IEN) ; -- return code^description for CPT code, or "^" if error
  1. N X0,VPRX,N,I,X,Y S IEN=+$G(IEN)
  1. S X0=$$CPT^ICPTCOD(IEN) I X0<0 Q "^"
  1. S Y=$P(X0,U,2,3) ;CPT Code^Short Name
  1. S N=$$CPTD^ICPTCOD($P(Y,U),"VPRX") ;CPT Description
  1. I N>0,$L($G(VPRX(1))) D
  1. . S X=$G(VPRX(1)),I=1
  1. . F S I=$O(VPRX(I)) Q:I<1 Q:VPRX(I)=" " S X=X_" "_VPRX(I)
  1. . S $P(Y,U,2)=X
  1. Q Y
  1. ;
  1. ; ------------ Return data to middle tier ------------
  1. ;
  1. XML(SURG) ; -- Return surgery as XML
  1. N ATT,X,Y,NAMES,I,J
  1. D ADD("<surgery>") S VPRTOTL=$G(VPRTOTL)+1
  1. S ATT="" F S ATT=$O(SURG(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
  1. . I $O(SURG(ATT,0)) D S Y="" Q ;multiples
  1. .. D ADD("<"_ATT_"s>")
  1. .. S I=0 F S I=$O(SURG(ATT,I)) Q:I<1 D
  1. ... S X=$G(SURG(ATT,I)),NAMES=""
  1. ... S NAMES=$S(ATT="document":"id^localTitle^nationalTitle^vuid^Z",1:"code^name^Z")
  1. ... S Y="<"_ATT_" "_$$LOOP ;_"/>" D ADD(Y)
  1. ... S X=$G(SURG(ATT,I,"content")) I '$L(X) S Y=Y_"/>" D ADD(Y) Q
  1. ... S Y=Y_">" D ADD(Y)
  1. ... S Y="<content xml:space='preserve'>" D ADD(Y)
  1. ... S J=0 F S J=$O(@X@(J)) Q:J<1 S Y=$$ESC^VPRD(@X@(J)) D ADD(Y)
  1. ... D ADD("</content>"),ADD("</"_ATT_">")
  1. .. D ADD("</"_ATT_"s>")
  1. . S X=$G(SURG(ATT)),Y="" Q:'$L(X)
  1. . I X'["^" S Y="<"_ATT_" value='"_$$ESC^VPRD(X)_"' />" Q
  1. . S NAMES=$S(ATT="opReport":"id^localTitle^nationalTitle^vuid",ATT="provider":"code^name^"_$$PROVTAGS^VPRD,1:"code^name")_"^Z"
  1. . I $L(X)>1 S Y="<"_ATT_" "_$$LOOP_"/>"
  1. D ADD("</surgery>")
  1. Q
  1. ;
  1. LOOP() ; -- build sub-items string from NAMES and X
  1. N STR,P,TAG S STR=""
  1. F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S STR=STR_TAG_"='"_$$ESC^VPRD($P(X,U,P))_"' "
  1. Q STR
  1. ;
  1. ADD(X) ; -- Add a line @VPR@(n)=X
  1. S VPRI=$G(VPRI)+1
  1. S @VPR@(VPRI)=X
  1. Q