- 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 Mar 13, 2025@21:22:24 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
