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

NHINVSR.m

Go to the documentation of this file. 
  1. NHINVSR ;SLC/MKB -- Surgical Procedures
  1.  ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; DIQ                           2056
  1.  ; STATUS^GMTSROB                3969
  1.  ; ICPTCOD                       1995
  1.  ; ICPTMOD                       1996
  1.  ; SROESTV                       3533
  1.  ; TIUSRVR1                      2944
  1.  ;
  1.  ; ------------ Get surgery(ies) from VistA ------------
  1.  ;
  1. EN(DFN,BEG,END,MAX,ID) ; -- find patient's surgeries
  1.  N NHI,NHICNT,NHITM,NHY
  1.  S DFN=+$G(DFN) Q:DFN<1
  1.  S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
  1.  ;
  1.  ; get one surgery
  1.  I $G(ID) D EN1(ID,.NHITM),XML(.NHITM) Q
  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(.NHY,DFN,BEG,END,MAX,1)
  1.  S NHI=0 F  S NHI=$O(@NHY@(NHI)) Q:NHI<1  D
  1.  . K NHITM D ONE(NHI,.NHITM)
  1.  . I $D(NHITM) D XML(.NHITM)
  1.  K @NHY
  1.  Q
  1.  ;
  1. ONE(NUM,SURG) ; -- return a surgery in SURG("attribute")=value
  1.  ;  Expects DFN, @NHY@(NUM) from LIST^SROESTV
  1.  N IEN,NHX,X,Y,I,NHMOD,NHOTH
  1.  S NHX=$G(@NHY@(NUM))
  1.  S IEN=+$P(NHX,U) Q:IEN<1  K SURG
  1.  S SURG("id")=IEN,SURG("name")=$P(NHX,U,2)
  1.  S SURG("dateTime")=$P(NHX,U,3)
  1.  S X=$P(NHX,U,4) S:X SURG("provider")=$TR(X,";","^")
  1.  S SURG("status")=$$STATUS(IEN,$P(NHX,U,3))
  1.  S X=$$GET1^DIQ(130,IEN_",",50,"I"),SURG("facility")=$$FAC^NHINV(X)
  1.  S SURG("encounter")=$$GET1^DIQ(130,IEN_",",.015,"I")
  1.  S X=$$GET1^DIQ(130,IEN_",",27,"I") I X D
  1.  . S SURG("type")=$$CPT(X)
  1.  . D GETS^DIQ(130,IEN_",","28*","I","NHMOD") ;CPT modifiers
  1.  . S I="" F  S I=$O(NHMOD(130.028,I)) Q:I=""  D
  1.  .. S X=+$G(NHMOD(130.028,I,.01,"I")),Y=$$MOD^ICPTMOD(X,"I")
  1.  .. S SURG("modifier",+I)=$P(Y,U,2,3)
  1.  D GETS^DIQ(130,IEN_",",".42*","I","NHOTH") ;other procedures
  1.  S I="" F  S I=$O(NHOTH(130.16,I)) Q:I=""  D
  1.  . S X=+$G(NHOTH(130.16,I,3,"I")) Q:'X
  1.  . S SURG("otherProcedure",+I)=$$CPT(X)
  1.  S I=0 F  S I=$O(@NHY@(NUM,I)) Q:I<1  S X=$G(@NHY@(NUM,I)) I X D
  1.  . N LT,NT S LT=$P(X,U,2) Q:$P(LT," ")="Addendum"
  1.  . S NT=$$GET1^DIQ(8925,+X_",",".01:1501")
  1.  . S SURG("document",I)=+X_U_LT_U_NT
  1.  . I LT["OPERATION REPORT"!(LT["PROCEDURE REPORT") S SURG("opReport")=+X_U_LT_U_NT
  1.  S SURG("category")="SR"
  1.  Q
  1.  ;
  1. EN1(IEN,SURG) ; -- return a surgery in SURG("attribute")=value
  1.  N NHX,NHY,X,Y,I,NHMOD,NHOTH,SHOWADD
  1.  S SHOWADD=1 ;to omit leading '+' with note titles
  1.  D ONE^SROESTV("NHY",IEN) S NHX=$G(NHY(IEN)) Q:NHX=""
  1.  S SURG("id")=IEN,SURG("name")=$P(NHX,U,2),SURG("dateTime")=$P(NHX,U,3)
  1.  S X=$P(NHX,U,4) S:X SURG("provider")=$TR(X,";","^")
  1.  S SURG("status")=$$STATUS(IEN,$P(NHX,U,3))
  1.  S X=$$GET1^DIQ(130,IEN_",",50,"I"),SURG("facility")=$$FAC^NHINV(X)
  1.  S SURG("encounter")=$$GET1^DIQ(130,IEN_",",.015,"I")
  1.  S X=$$GET1^DIQ(130,IEN_",",27,"I") I X D
  1.  . S SURG("type")=$$CPT(X)
  1.  . D GETS^DIQ(130,IEN_",","28*","I","NHMOD") ;CPT modifiers
  1.  . S I="" F  S I=$O(NHMOD(130.028,I)) Q:I=""  D
  1.  .. S X=+$G(NHMOD(130.028,I,.01,"I")),Y=$$MOD^ICPTMOD(X,"I")
  1.  .. S SURG("modifier",+I)=$P(Y,U,2,3)
  1.  D GETS^DIQ(130,"28,",".42*","I","NHOTH") ;other procedures
  1.  S I="" F  S I=$O(NHOTH(130.16,I)) Q:I=""  D
  1.  . S X=+$G(NHOTH(130.16,I,3,"I")) Q:'X
  1.  . S SURG("otherProcedure",+I)=$$CPT(X)
  1.  S I=0 F  S I=$O(NHY(IEN,I)) Q:I<1  S X=$G(NHY(IEN,I)) I X D
  1.  . N LT,NT S LT=$P(X,U,2) Q:$P(LT," ")="Addendum"
  1.  . S NT=$$GET1^DIQ(8925,+X_",",".01:1501")
  1.  . S SURG("document",I)=+X_U_LT_U_NT
  1.  . I LT["OPERATION REPORT"!(LT["PROCEDURE REPORT") S SURG("opReport")=+X_U_LT_U_NT
  1.  S SURG("category")="SR"
  1.  Q
  1.  ;
  1. CPT(IEN) ; -- return code^description for CPT code, or "^" if error
  1.  N X0,NHX,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),"NHX") ;CPT Description
  1.  I N>0,$L($G(NHX(1))) D
  1.  . S X=$G(NHX(1)),I=1
  1.  . F  S I=$O(NHX(I)) Q:I<1  Q:NHX(I)=" "  S X=X_" "_NHX(I)
  1.  . S $P(Y,U,2)=X
  1.  Q Y
  1.  ;
  1. STATUS(GMN,GMDT) ; -- get current STATUS of request
  1.  N STATUS S STATUS="UNKNOWN"
  1.  I $G(GMN),$G(GMDT) D STATUS^GMTSROB
  1.  I $E(STATUS)="(" S STATUS=$P($P(STATUS,"(",2),")")
  1.  Q STATUS
  1.  ;
  1.  ; ------------ Return data to middle tier ------------
  1.  ;
  1. XML(SURG) ; -- Return surgery as XML
  1.  N ATT,X,Y,NAMES
  1.  D ADD("<surgery>") S NHINTOTL=$G(NHINTOTL)+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^Z",1:"code^name^Z")
  1.  ... S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
  1.  .. D ADD("</"_ATT_"s>")
  1.  . S X=$G(SURG(ATT)),Y="" Q:'$L(X)
  1.  . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
  1.  . S NAMES=$S(ATT="opReport":"id^localTitle^nationalTitle^Z",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^NHINV($P(X,U,P))_"' "
  1.  Q STR
  1.  ;
  1. ADD(X) ; -- Add a line @NHIN@(n)=X
  1.  S NHINI=$G(NHINI)+1
  1.  S @NHIN@(NHINI)=X
  1.  Q
  1.  ;
  1. RPT(NHY,ID) ; -- Return report in NHY(n)
  1.  S ID=+$G(ID) Q:ID<1
  1.  D TGET^TIUSRVR1(.NHY,ID)
  1.  Q