NHINVPRC ;SLC/MKB -- Procedure extract
;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
;
; External References DBIA#
; ------------------- -----
; RAO7PC1 2043
; SROESTV 3533
;
; ------------ Get procedure(s) from VistA ------------
;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's procedures
S DFN=+$G(DFN) Q:DFN<1
S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
;
N NHI,NHICNT,NHITM,NHY
;
; get one procedure
I $G(ID) D D:$D(NHITM) XML(.NHITM) Q
. I ID'["-" D EN1^NHINVSR(ID,.NHITM) Q
. S (BEG,END)=9999999.9999=+ID
. D EN1^RAO7PC1(DFN,BEG,END),EN1^NHINVRA(ID,.NHITM)
;
; get all surgeries
N SHOWADD S SHOWADD=1 ;to omit leading '+' with note titles
D LIST^SROESTV(.NHY,DFN,BEG,END,MAX,1)
S NHI=0 F S NHI=$O(@NHY@(NHI)) Q:NHI<1 D
. K NHITM D ONE^NHINVSR(NHI,.NHITM) Q:'$D(NHITM)
. ;Q:$G(NHITM("status"))'?1"COMP".E
. D XML(.NHITM)
K @NHY
;
; get all radiology exams
K ^TMP($J,"RAE1") D EN1^RAO7PC1(DFN,BEG,END,MAX)
S NHICNT=0,NHI=""
F S NHI=$O(^TMP($J,"RAE1",DFN,NHI)) Q:NHI="" D Q:NHICNT'<MAX ;I $P($P($G(^(NHI)),U,6),"~",2)?1"COMP".E
. K NHITM D EN1^NHINVRA(NHI,.NHITM) Q:'$D(NHITM)
. D XML(.NHITM) S NHICNT=NHICNT+1
K ^TMP($J,"RAE1")
;
; Consults/ClinProc
; V-files [CPT, Exam, Treatment, Patient ED]
;
Q
;
; ------------ Return data to middle tier ------------
;
XML(PRC) ; -- Return procedures as XML
N ATT,X,Y,I,NAMES
D ADD("<procedure>") S NHINTOTL=$G(NHINTOTL)+1
S ATT="" F S ATT=$O(PRC(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
. S NAMES=$S(ATT="document"!(ATT="opReport"):"id^localTitle^nationalTitle^status^Z",1:"code^name^Z")
. I $O(PRC(ATT,0)) D S Y="" Q ;multiples
.. D ADD("<"_ATT_"s>")
.. S I=0 F S I=$O(PRC(ATT,I)) Q:I<1 D
... S X=$G(PRC(ATT,I))
... S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
.. D ADD("</"_ATT_"s>")
. S X=$G(PRC(ATT)),Y="" Q:'$L(X)
. I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
. I $L(X)>1 S Y="<"_ATT_" "_$$LOOP_"/>"
D ADD("</procedure>")
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^NHINV($P(X,U,P))_"' "
Q STR
;
ADD(X) ; -- Add a line @NHIN@(n)=X
S NHINI=$G(NHINI)+1
S @NHIN@(NHINI)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNHINVPRC 2352 printed Apr 09, 2024@21:20:20 Page 2
NHINVPRC ;SLC/MKB -- Procedure extract
+1 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
+2 ;
+3 ; External References DBIA#
+4 ; ------------------- -----
+5 ; RAO7PC1 2043
+6 ; SROESTV 3533
+7 ;
+8 ; ------------ Get procedure(s) from VistA ------------
+9 ;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's procedures
+1 SET DFN=+$GET(DFN)
if DFN<1
QUIT
+2 SET BEG=$GET(BEG,1410101)
SET END=$GET(END,9999998)
SET MAX=$GET(MAX,999999)
+3 ;
+4 NEW NHI,NHICNT,NHITM,NHY
+5 ;
+6 ; get one procedure
+7 IF $GET(ID)
Begin DoDot:1
+8 IF ID'["-"
DO EN1^NHINVSR(ID,.NHITM)
QUIT
+9 SET (BEG,END)=9999999.9999=+ID
+10 DO EN1^RAO7PC1(DFN,BEG,END)
DO EN1^NHINVRA(ID,.NHITM)
End DoDot:1
if $DATA(NHITM)
DO XML(.NHITM)
QUIT
+11 ;
+12 ; get all surgeries
+13 ;to omit leading '+' with note titles
NEW SHOWADD
SET SHOWADD=1
+14 DO LIST^SROESTV(.NHY,DFN,BEG,END,MAX,1)
+15 SET NHI=0
FOR
SET NHI=$ORDER(@NHY@(NHI))
if NHI<1
QUIT
Begin DoDot:1
+16 KILL NHITM
DO ONE^NHINVSR(NHI,.NHITM)
if '$DATA(NHITM)
QUIT
+17 ;Q:$G(NHITM("status"))'?1"COMP".E
+18 DO XML(.NHITM)
End DoDot:1
+19 KILL @NHY
+20 ;
+21 ; get all radiology exams
+22 KILL ^TMP($JOB,"RAE1")
DO EN1^RAO7PC1(DFN,BEG,END,MAX)
+23 SET NHICNT=0
SET NHI=""
+24 ;I $P($P($G(^(NHI)),U,6),"~",2)?1"COMP".E
FOR
SET NHI=$ORDER(^TMP($JOB,"RAE1",DFN,NHI))
if NHI=""
QUIT
Begin DoDot:1
+25 KILL NHITM
DO EN1^NHINVRA(NHI,.NHITM)
if '$DATA(NHITM)
QUIT
+26 DO XML(.NHITM)
SET NHICNT=NHICNT+1
End DoDot:1
if NHICNT'<MAX
QUIT
+27 KILL ^TMP($JOB,"RAE1")
+28 ;
+29 ; Consults/ClinProc
+30 ; V-files [CPT, Exam, Treatment, Patient ED]
+31 ;
+32 QUIT
+33 ;
+34 ; ------------ Return data to middle tier ------------
+35 ;
XML(PRC) ; -- Return procedures as XML
+1 NEW ATT,X,Y,I,NAMES
+2 DO ADD("<procedure>")
SET NHINTOTL=$GET(NHINTOTL)+1
+3 SET ATT=""
FOR
SET ATT=$ORDER(PRC(ATT))
if ATT=""
QUIT
Begin DoDot:1
+4 SET NAMES=$SELECT(ATT="document"!(ATT="opReport"):"id^localTitle^nationalTitle^status^Z",1:"code^name^Z")
+5 ;multiples
IF $ORDER(PRC(ATT,0))
Begin DoDot:2
+6 DO ADD("<"_ATT_"s>")
+7 SET I=0
FOR
SET I=$ORDER(PRC(ATT,I))
if I<1
QUIT
Begin DoDot:3
+8 SET X=$GET(PRC(ATT,I))
+9 SET Y="<"_ATT_" "_$$LOOP_"/>"
DO ADD(Y)
End DoDot:3
+10 DO ADD("</"_ATT_"s>")
End DoDot:2
SET Y=""
QUIT
+11 SET X=$GET(PRC(ATT))
SET Y=""
if '$LENGTH(X)
QUIT
+12 IF X'["^"
SET Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
QUIT
+13 IF $LENGTH(X)>1
SET Y="<"_ATT_" "_$$LOOP_"/>"
End DoDot:1
if $LENGTH(Y)
DO ADD(Y)
+14 DO ADD("</procedure>")
+15 QUIT
+16 ;
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^NHINV($PIECE(X,U,P))_"' "
+3 QUIT STR
+4 ;
ADD(X) ; -- Add a line @NHIN@(n)=X
+1 SET NHINI=$GET(NHINI)+1
+2 SET @NHIN@(NHINI)=X
+3 QUIT
