VPRSDASR ;SLC/MKB -- SDA Surgery utilities ;7/29/22 15:29
;;1.0;VIRTUAL PATIENT RECORD;**30**;Sep 01, 2011;Build 9
;;Per VA Directive 6402, this routine should not be modified.
;
; Supported by DBIA #4750
;
; External References DBIA#
; ------------------- -----
; ^SRF 5675
; DIQ 2056
; SROESTV 3533
;
;
QRY ; -- get Surgeries
; Query called from GET^DDE, returns DLIST(#)=ien
; Expects context variables DFN, DSTRT, DSTOP, DMAX
;
N VPRY,VPRN,I,X
D LIST^SROESTV(.VPRY,DFN,DSTRT,DSTOP,DMAX,1)
S VPRN=0 F S VPRN=$O(@VPRY@(VPRN)) Q:VPRN<1 I $G(@VPRY@(VPRN)) D
. S I=+$O(@VPRY@(VPRN,0)) Q:I<1
. S X=$G(@VPRY@(VPRN,I)) ;TIU ien ^ $$RESOLVE^TIUSRVLO data string
. I $P(X,U,7)'="completed",$P(X,U,7)'="amended" Q
. I $P(X,U,2)["Addendum to " Q
. S DLIST(VPRN)=+$G(@VPRY@(VPRN))
K @VPRY
Q
;
PROC(IEN) ; -- returns primary CPT code^name[^CPT-4] for surgery IEN in
; VALUE = procedure code^name
; DATA = Prin Procedure name
N X,SROP,SDT
I $G(VPRSR(+$G(IEN)))="" Q
S X=$P(VPRSR(IEN),U,2),SDT=$P(VPRSR(IEN),U,3)
; Use CPT ien if defined
S SROP=$$GET1^DIQ(136,IEN_",",.02,"I")
S:'SROP SROP=$P($G(^SRF(IEN,"OP")),U,2)
I SROP S VALUE=$$CPT^VPRSDA(SROP,SDT),DATA=X Q
; else use procedure name for both pieces
S VALUE=X_U_X
Q
;
RPTS(IEN) ; -- put Op Reports into DLIST(#) = TIU ien
N I,X S IEN=+$G(IEN)
S I=0 F S I=$O(VPRSR(IEN,I)) Q:I<1 S X=$G(VPRSR(IEN,I)) I X D
. ;X = ien ^ $$RESOLVE^TIUSRVLO data string
. I $P(X,U,7)'="completed",$P(X,U,7)'="amended" Q
. I $P(X,U,2)["Addendum to " Q
. S DLIST(I)=+X_";TIU"
. ; X["OPERATION REPORT"!(X["PROCEDURE REPORT") S SURG("opReport")=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRSDASR 1763 printed Apr 09, 2024@21:47:28 Page 2
VPRSDASR ;SLC/MKB -- SDA Surgery utilities ;7/29/22 15:29
+1 ;;1.0;VIRTUAL PATIENT RECORD;**30**;Sep 01, 2011;Build 9
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Supported by DBIA #4750
+5 ;
+6 ; External References DBIA#
+7 ; ------------------- -----
+8 ; ^SRF 5675
+9 ; DIQ 2056
+10 ; SROESTV 3533
+11 ;
+12 ;
QRY ; -- get Surgeries
+1 ; Query called from GET^DDE, returns DLIST(#)=ien
+2 ; Expects context variables DFN, DSTRT, DSTOP, DMAX
+3 ;
+4 NEW VPRY,VPRN,I,X
+5 DO LIST^SROESTV(.VPRY,DFN,DSTRT,DSTOP,DMAX,1)
+6 SET VPRN=0
FOR
SET VPRN=$ORDER(@VPRY@(VPRN))
if VPRN<1
QUIT
IF $GET(@VPRY@(VPRN))
Begin DoDot:1
+7 SET I=+$ORDER(@VPRY@(VPRN,0))
if I<1
QUIT
+8 ;TIU ien ^ $$RESOLVE^TIUSRVLO data string
SET X=$GET(@VPRY@(VPRN,I))
+9 IF $PIECE(X,U,7)'="completed"
IF $PIECE(X,U,7)'="amended"
QUIT
+10 IF $PIECE(X,U,2)["Addendum to "
QUIT
+11 SET DLIST(VPRN)=+$GET(@VPRY@(VPRN))
End DoDot:1
+12 KILL @VPRY
+13 QUIT
+14 ;
PROC(IEN) ; -- returns primary CPT code^name[^CPT-4] for surgery IEN in
+1 ; VALUE = procedure code^name
+2 ; DATA = Prin Procedure name
+3 NEW X,SROP,SDT
+4 IF $GET(VPRSR(+$GET(IEN)))=""
QUIT
+5 SET X=$PIECE(VPRSR(IEN),U,2)
SET SDT=$PIECE(VPRSR(IEN),U,3)
+6 ; Use CPT ien if defined
+7 SET SROP=$$GET1^DIQ(136,IEN_",",.02,"I")
+8 if 'SROP
SET SROP=$PIECE($GET(^SRF(IEN,"OP")),U,2)
+9 IF SROP
SET VALUE=$$CPT^VPRSDA(SROP,SDT)
SET DATA=X
QUIT
+10 ; else use procedure name for both pieces
+11 SET VALUE=X_U_X
+12 QUIT
+13 ;
RPTS(IEN) ; -- put Op Reports into DLIST(#) = TIU ien
+1 NEW I,X
SET IEN=+$GET(IEN)
+2 SET I=0
FOR
SET I=$ORDER(VPRSR(IEN,I))
if I<1
QUIT
SET X=$GET(VPRSR(IEN,I))
IF X
Begin DoDot:1
+3 ;X = ien ^ $$RESOLVE^TIUSRVLO data string
+4 IF $PIECE(X,U,7)'="completed"
IF $PIECE(X,U,7)'="amended"
QUIT
+5 IF $PIECE(X,U,2)["Addendum to "
QUIT
+6 SET DLIST(I)=+X_";TIU"
+7 ; X["OPERATION REPORT"!(X["PROCEDURE REPORT") S SURG("opReport")=X
End DoDot:1
+8 QUIT
