HMPDSR ;SLC/MKB,ASMR/RRB - Surgical Procedures;Aug 29, 2016 20:06:27
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^SRF(130 5675
; ^SRO(136 4872
; DIQ 2056
; ICPTCOD 1995
; ICPTMOD 1996
; SROESTV 3533
Q
; ------------ Get surgery(ies) from VistA ------------
;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's surgeries
N HMPN,HMPCNT,HMPITM,HMPY
S DFN=+$G(DFN) I '(DFN>0) D LOGDPT^HMPLOG(DFN) Q ;DE4496 19 August 2016
S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
;
; get one surgery
I $G(ID) D EN1(ID,.HMPITM),XML(.HMPITM) G ENQ
;
; get all surgeries
Q:'$L($T(LIST^SROESTV))
N SHOWADD S SHOWADD=1 ;to omit leading '+' with note titles
D LIST^SROESTV(.HMPY,DFN,BEG,END,MAX,1)
S HMPN=0 F S HMPN=$O(@HMPY@(HMPN)) Q:HMPN<1 D
. K HMPITM D ONE(HMPN,.HMPITM)
. I $D(HMPITM) D XML(.HMPITM)
K @HMPY
ENQ ; end
K ^TMP("HMPTEXT",$J)
Q
;
ONE(NUM,SURG) ; -- return a surgery in SURG("attribute")=value
; Expects DFN, @HMPY@(NUM) from LIST^SROESTV
N IEN,HMPX,X,Y,I,HMPMOD,HMPOTH
K SURG,^TMP("HMPTEXT",$J)
S HMPX=$G(@HMPY@(NUM)),IEN=+$P(HMPX,U) Q:IEN<1
S SURG("id")=IEN,X=$P(HMPX,U,2),SURG("status")="COMPLETED"
I X?1"* Aborted * ".E S X=$E(X,13,999),SURG("status")="ABORTED"
S SURG("name")=X,SURG("dateTime")=$P(HMPX,U,3)
S X=$P(HMPX,U,4) S:X SURG("provider")=$TR(X,";","^")
S X=$$GET1^DIQ(130,IEN_",",50,"I"),SURG("facility")=$$FAC^HMPD(X)
S SURG("encounter")=$$GET1^DIQ(130,IEN_",",.015,"I")
S X=$$GET1^DIQ(136,IEN_",",.02,"I") I X D
. S SURG("type")=$$CPT(X)
. D GETS^DIQ(136,IEN_",","1*","I","HMPMOD") ;CPT modifiers
. S I="" F S I=$O(HMPMOD(136.01,I)) Q:I="" D
.. S X=+$G(HMPMOD(136.01,I,.01,"I")),Y=$$MOD^ICPTMOD(X,"I")
.. S SURG("modifier",+I)=$P(Y,U,2,3)
D GETS^DIQ(136,IEN_",","3*","I","HMPOTH") ;other procedures
S I="" F S I=$O(HMPOTH(136.03,I)) Q:I="" D
. S X=+$G(HMPOTH(136.03,I,.01,"I")) Q:'X
. S SURG("otherProcedure",+I)=$$CPT(X)
S I=0 F S I=$O(@HMPY@(NUM,I)) Q:I<1 S X=$G(@HMPY@(NUM,I)) I X D
. N LT,NT S LT=$P(X,U,2) Q:$P(LT," ")="Addendum"
. S NT=$$GET1^DIQ(8925,+X_",",".01:1501")
. S SURG("document",I)=+X_U_LT_U_NT
. S:$G(HMPTEXT) SURG("document",I,"content")=$$TEXT^HMPDTIU(+X)
. I LT["OPERATION REPORT"!(LT["PROCEDURE REPORT") S SURG("opReport")=+X_U_LT_U_NT
S SURG("category")="SR"
Q
;
EN1(IEN,SURG) ; -- return a surgery in SURG("attribute")=value
N HMPX,HMPY,X,Y,I,HMPMOD,HMPOTH,SHOWADD
K SURG,^TMP("HMPTEXT",$J)
S SHOWADD=1 ;to omit leading '+' with note titles
D ONE^SROESTV("HMPY",IEN) S HMPX=$G(HMPY(IEN)) Q:HMPX=""
S SURG("id")=IEN,X=$P(HMPX,U,2),SURG("status")="COMPLETED"
I X?1"* Aborted * ".E S X=$E(X,13,999),SURG("status")="ABORTED"
S SURG("name")=X,SURG("dateTime")=$P(HMPX,U,3)
S X=$P(HMPX,U,4) S:X SURG("provider")=$TR(X,";","^")
S X=$$GET1^DIQ(130,IEN_",",50,"I"),SURG("facility")=$$FAC^HMPD(X)
S SURG("encounter")=$$GET1^DIQ(130,IEN_",",.015,"I")
S X=$$GET1^DIQ(136,IEN_",",.02,"I") I X D
. S SURG("type")=$$CPT(X)
. D GETS^DIQ(136,IEN_",","1*","I","HMPMOD") ;CPT modifiers
. S I="" F S I=$O(HMPMOD(136.01,I)) Q:I="" D
.. S X=+$G(HMPMOD(136.01,I,.01,"I")),Y=$$MOD^ICPTMOD(X,"I")
.. S SURG("modifier",+I)=$P(Y,U,2,3)
D GETS^DIQ(136,IEN_",","3*","I","HMPOTH") ;other procedures
S I="" F S I=$O(HMPOTH(136.03,I)) Q:I="" D
. S X=+$G(HMPOTH(136.03,I,.01,"I")) Q:'X
. S SURG("otherProcedure",+I)=$$CPT(X)
S I=0 F S I=$O(HMPY(IEN,I)) Q:I<1 S X=$G(HMPY(IEN,I)) I X D
. N LT,NT S LT=$P(X,U,2) Q:$P(LT," ")="Addendum"
. S NT=$$GET1^DIQ(8925,+X_",",".01:1501")
. S SURG("document",I)=+X_U_LT_U_NT
. S:$G(HMPTEXT) SURG("document",I,"content")=$$TEXT^HMPDTIU(+X)
. I LT["OPERATION REPORT"!(LT["PROCEDURE REPORT") S SURG("opReport")=+X_U_LT_U_NT
S SURG("category")="SR"
Q
;
CPT(IEN) ; -- return code^description for CPT code, or "^" if error
N X0,HMPX,N,I,X,Y S IEN=+$G(IEN)
S X0=$$CPT^ICPTCOD(IEN) I X0<0 Q "^"
S Y=$P(X0,U,2,3) ;CPT Code^Short Name
S N=$$CPTD^ICPTCOD($P(Y,U),"HMPX") ;CPT Description
I N>0,$L($G(HMPX(1))) D
. S X=$G(HMPX(1)),I=1
. F S I=$O(HMPX(I)) Q:I<1 Q:HMPX(I)=" " S X=X_" "_HMPX(I)
. S $P(Y,U,2)=X
Q Y
;
; ------------ Return data to middle tier ------------
;
XML(SURG) ; -- Return surgery as XML
N ATT,X,Y,NAMES,I,J
D ADD("<surgery>") S HMPTOTL=$G(HMPTOTL)+1
S ATT="" F S ATT=$O(SURG(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
. I $O(SURG(ATT,0)) D S Y="" Q ;multiples
.. D ADD("<"_ATT_"s>")
.. S I=0 F S I=$O(SURG(ATT,I)) Q:I<1 D
... S X=$G(SURG(ATT,I)),NAMES=""
... S NAMES=$S(ATT="document":"id^localTitle^nationalTitle^Z",1:"code^name^Z")
... S Y="<"_ATT_" "_$$LOOP ;_"/>" D ADD(Y)
... S X=$G(SURG(ATT,I,"content")) I '$L(X) S Y=Y_"/>" D ADD(Y) Q
... S Y=Y_">" D ADD(Y)
... S Y="<content xml:space='preserve'>" D ADD(Y)
... S J=0 F S J=$O(@X@(J)) Q:J<1 S Y=$$ESC^HMPD(@X@(J)) D ADD(Y)
... D ADD("</content>"),ADD("</"_ATT_">")
.. D ADD("</"_ATT_"s>")
. S X=$G(SURG(ATT)),Y="" Q:'$L(X)
. I X'["^" S Y="<"_ATT_" value='"_$$ESC^HMPD(X)_"' />" Q
. S NAMES=$S(ATT="opReport":"id^localTitle^nationalTitle^Z",1:"code^name^Z")
. I $L(X)>1 S Y="<"_ATT_" "_$$LOOP_"/>"
D ADD("</surgery>")
Q
;
LOOP() ; -- build sub-items string from NAMES and X
N STR,P,TAG S STR=""
F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S STR=STR_TAG_"='"_$$ESC^HMPD($P(X,U,P))_"' "
Q STR
;
ADD(X) ; -- Add a line @HMP@(n)=X
S HMPI=$G(HMPI)+1
S @HMP@(HMPI)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDSR 5790 printed Apr 09, 2024@20:59:44 Page 2
HMPDSR ;SLC/MKB,ASMR/RRB - Surgical Procedures;Aug 29, 2016 20:06:27
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^SRF(130 5675
+7 ; ^SRO(136 4872
+8 ; DIQ 2056
+9 ; ICPTCOD 1995
+10 ; ICPTMOD 1996
+11 ; SROESTV 3533
+12 QUIT
+13 ; ------------ Get surgery(ies) from VistA ------------
+14 ;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's surgeries
+1 NEW HMPN,HMPCNT,HMPITM,HMPY
+2 ;DE4496 19 August 2016
SET DFN=+$GET(DFN)
IF '(DFN>0)
DO LOGDPT^HMPLOG(DFN)
QUIT
+3 SET BEG=$GET(BEG,1410101)
SET END=$GET(END,4141015)
SET MAX=$GET(MAX,9999)
+4 ;
+5 ; get one surgery
+6 IF $GET(ID)
DO EN1(ID,.HMPITM)
DO XML(.HMPITM)
GOTO ENQ
+7 ;
+8 ; get all surgeries
+9 if '$LENGTH($TEXT(LIST^SROESTV))
QUIT
+10 ;to omit leading '+' with note titles
NEW SHOWADD
SET SHOWADD=1
+11 DO LIST^SROESTV(.HMPY,DFN,BEG,END,MAX,1)
+12 SET HMPN=0
FOR
SET HMPN=$ORDER(@HMPY@(HMPN))
if HMPN<1
QUIT
Begin DoDot:1
+13 KILL HMPITM
DO ONE(HMPN,.HMPITM)
+14 IF $DATA(HMPITM)
DO XML(.HMPITM)
End DoDot:1
+15 KILL @HMPY
ENQ ; end
+1 KILL ^TMP("HMPTEXT",$JOB)
+2 QUIT
+3 ;
ONE(NUM,SURG) ; -- return a surgery in SURG("attribute")=value
+1 ; Expects DFN, @HMPY@(NUM) from LIST^SROESTV
+2 NEW IEN,HMPX,X,Y,I,HMPMOD,HMPOTH
+3 KILL SURG,^TMP("HMPTEXT",$JOB)
+4 SET HMPX=$GET(@HMPY@(NUM))
SET IEN=+$PIECE(HMPX,U)
if IEN<1
QUIT
+5 SET SURG("id")=IEN
SET X=$PIECE(HMPX,U,2)
SET SURG("status")="COMPLETED"
+6 IF X?1"* Aborted * ".E
SET X=$EXTRACT(X,13,999)
SET SURG("status")="ABORTED"
+7 SET SURG("name")=X
SET SURG("dateTime")=$PIECE(HMPX,U,3)
+8 SET X=$PIECE(HMPX,U,4)
if X
SET SURG("provider")=$TRANSLATE(X,";","^")
+9 SET X=$$GET1^DIQ(130,IEN_",",50,"I")
SET SURG("facility")=$$FAC^HMPD(X)
+10 SET SURG("encounter")=$$GET1^DIQ(130,IEN_",",.015,"I")
+11 SET X=$$GET1^DIQ(136,IEN_",",.02,"I")
IF X
Begin DoDot:1
+12 SET SURG("type")=$$CPT(X)
+13 ;CPT modifiers
DO GETS^DIQ(136,IEN_",","1*","I","HMPMOD")
+14 SET I=""
FOR
SET I=$ORDER(HMPMOD(136.01,I))
if I=""
QUIT
Begin DoDot:2
+15 SET X=+$GET(HMPMOD(136.01,I,.01,"I"))
SET Y=$$MOD^ICPTMOD(X,"I")
+16 SET SURG("modifier",+I)=$PIECE(Y,U,2,3)
End DoDot:2
End DoDot:1
+17 ;other procedures
DO GETS^DIQ(136,IEN_",","3*","I","HMPOTH")
+18 SET I=""
FOR
SET I=$ORDER(HMPOTH(136.03,I))
if I=""
QUIT
Begin DoDot:1
+19 SET X=+$GET(HMPOTH(136.03,I,.01,"I"))
if 'X
QUIT
+20 SET SURG("otherProcedure",+I)=$$CPT(X)
End DoDot:1
+21 SET I=0
FOR
SET I=$ORDER(@HMPY@(NUM,I))
if I<1
QUIT
SET X=$GET(@HMPY@(NUM,I))
IF X
Begin DoDot:1
+22 NEW LT,NT
SET LT=$PIECE(X,U,2)
if $PIECE(LT," ")="Addendum"
QUIT
+23 SET NT=$$GET1^DIQ(8925,+X_",",".01:1501")
+24 SET SURG("document",I)=+X_U_LT_U_NT
+25 if $GET(HMPTEXT)
SET SURG("document",I,"content")=$$TEXT^HMPDTIU(+X)
+26 IF LT["OPERATION REPORT"!(LT["PROCEDURE REPORT")
SET SURG("opReport")=+X_U_LT_U_NT
End DoDot:1
+27 SET SURG("category")="SR"
+28 QUIT
+29 ;
EN1(IEN,SURG) ; -- return a surgery in SURG("attribute")=value
+1 NEW HMPX,HMPY,X,Y,I,HMPMOD,HMPOTH,SHOWADD
+2 KILL SURG,^TMP("HMPTEXT",$JOB)
+3 ;to omit leading '+' with note titles
SET SHOWADD=1
+4 DO ONE^SROESTV("HMPY",IEN)
SET HMPX=$GET(HMPY(IEN))
if HMPX=""
QUIT
+5 SET SURG("id")=IEN
SET X=$PIECE(HMPX,U,2)
SET SURG("status")="COMPLETED"
+6 IF X?1"* Aborted * ".E
SET X=$EXTRACT(X,13,999)
SET SURG("status")="ABORTED"
+7 SET SURG("name")=X
SET SURG("dateTime")=$PIECE(HMPX,U,3)
+8 SET X=$PIECE(HMPX,U,4)
if X
SET SURG("provider")=$TRANSLATE(X,";","^")
+9 SET X=$$GET1^DIQ(130,IEN_",",50,"I")
SET SURG("facility")=$$FAC^HMPD(X)
+10 SET SURG("encounter")=$$GET1^DIQ(130,IEN_",",.015,"I")
+11 SET X=$$GET1^DIQ(136,IEN_",",.02,"I")
IF X
Begin DoDot:1
+12 SET SURG("type")=$$CPT(X)
+13 ;CPT modifiers
DO GETS^DIQ(136,IEN_",","1*","I","HMPMOD")
+14 SET I=""
FOR
SET I=$ORDER(HMPMOD(136.01,I))
if I=""
QUIT
Begin DoDot:2
+15 SET X=+$GET(HMPMOD(136.01,I,.01,"I"))
SET Y=$$MOD^ICPTMOD(X,"I")
+16 SET SURG("modifier",+I)=$PIECE(Y,U,2,3)
End DoDot:2
End DoDot:1
+17 ;other procedures
DO GETS^DIQ(136,IEN_",","3*","I","HMPOTH")
+18 SET I=""
FOR
SET I=$ORDER(HMPOTH(136.03,I))
if I=""
QUIT
Begin DoDot:1
+19 SET X=+$GET(HMPOTH(136.03,I,.01,"I"))
if 'X
QUIT
+20 SET SURG("otherProcedure",+I)=$$CPT(X)
End DoDot:1
+21 SET I=0
FOR
SET I=$ORDER(HMPY(IEN,I))
if I<1
QUIT
SET X=$GET(HMPY(IEN,I))
IF X
Begin DoDot:1
+22 NEW LT,NT
SET LT=$PIECE(X,U,2)
if $PIECE(LT," ")="Addendum"
QUIT
+23 SET NT=$$GET1^DIQ(8925,+X_",",".01:1501")
+24 SET SURG("document",I)=+X_U_LT_U_NT
+25 if $GET(HMPTEXT)
SET SURG("document",I,"content")=$$TEXT^HMPDTIU(+X)
+26 IF LT["OPERATION REPORT"!(LT["PROCEDURE REPORT")
SET SURG("opReport")=+X_U_LT_U_NT
End DoDot:1
+27 SET SURG("category")="SR"
+28 QUIT
+29 ;
CPT(IEN) ; -- return code^description for CPT code, or "^" if error
+1 NEW X0,HMPX,N,I,X,Y
SET IEN=+$GET(IEN)
+2 SET X0=$$CPT^ICPTCOD(IEN)
IF X0<0
QUIT "^"
+3 ;CPT Code^Short Name
SET Y=$PIECE(X0,U,2,3)
+4 ;CPT Description
SET N=$$CPTD^ICPTCOD($PIECE(Y,U),"HMPX")
+5 IF N>0
IF $LENGTH($GET(HMPX(1)))
Begin DoDot:1
+6 SET X=$GET(HMPX(1))
SET I=1
+7 FOR
SET I=$ORDER(HMPX(I))
if I<1
QUIT
if HMPX(I)=" "
QUIT
SET X=X_" "_HMPX(I)
+8 SET $PIECE(Y,U,2)=X
End DoDot:1
+9 QUIT Y
+10 ;
+11 ; ------------ Return data to middle tier ------------
+12 ;
XML(SURG) ; -- Return surgery as XML
+1 NEW ATT,X,Y,NAMES,I,J
+2 DO ADD("<surgery>")
SET HMPTOTL=$GET(HMPTOTL)+1
+3 SET ATT=""
FOR
SET ATT=$ORDER(SURG(ATT))
if ATT=""
QUIT
Begin DoDot:1
+4 ;multiples
IF $ORDER(SURG(ATT,0))
Begin DoDot:2
+5 DO ADD("<"_ATT_"s>")
+6 SET I=0
FOR
SET I=$ORDER(SURG(ATT,I))
if I<1
QUIT
Begin DoDot:3
+7 SET X=$GET(SURG(ATT,I))
SET NAMES=""
+8 SET NAMES=$SELECT(ATT="document":"id^localTitle^nationalTitle^Z",1:"code^name^Z")
+9 ;_"/>" D ADD(Y)
SET Y="<"_ATT_" "_$$LOOP
+10 SET X=$GET(SURG(ATT,I,"content"))
IF '$LENGTH(X)
SET Y=Y_"/>"
DO ADD(Y)
QUIT
+11 SET Y=Y_">"
DO ADD(Y)
+12 SET Y="<content xml:space='preserve'>"
DO ADD(Y)
+13 SET J=0
FOR
SET J=$ORDER(@X@(J))
if J<1
QUIT
SET Y=$$ESC^HMPD(@X@(J))
DO ADD(Y)
+14 DO ADD("</content>")
DO ADD("</"_ATT_">")
End DoDot:3
+15 DO ADD("</"_ATT_"s>")
End DoDot:2
SET Y=""
QUIT
+16 SET X=$GET(SURG(ATT))
SET Y=""
if '$LENGTH(X)
QUIT
+17 IF X'["^"
SET Y="<"_ATT_" value='"_$$ESC^HMPD(X)_"' />"
QUIT
+18 SET NAMES=$SELECT(ATT="opReport":"id^localTitle^nationalTitle^Z",1:"code^name^Z")
+19 IF $LENGTH(X)>1
SET Y="<"_ATT_" "_$$LOOP_"/>"
End DoDot:1
if $LENGTH(Y)
DO ADD(Y)
+20 DO ADD("</surgery>")
+21 QUIT
+22 ;
LOOP() ; -- build sub-items string from NAMES and X
+1 NEW STR,P,TAG
SET STR=""
+2 FOR P=1:1
SET TAG=$PIECE(NAMES,U,P)
if TAG="Z"
QUIT
IF $LENGTH($PIECE(X,U,P))
SET STR=STR_TAG_"='"_$$ESC^HMPD($PIECE(X,U,P))_"' "
+3 QUIT STR
+4 ;
ADD(X) ; -- Add a line @HMP@(n)=X
+1 SET HMPI=$GET(HMPI)+1
+2 SET @HMP@(HMPI)=X
+3 QUIT
