VPRSDASR.m

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 ---VPRSDASR   1763     printed  Mar 13, 2025@21:51:02                                                                                                                                                                                                    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