- NHINVPS ;SLC/MKB -- Pharmacy extract
- ;;1.0;NHIN;**1**;Dec 01, 2009;Build 11
- ;
- ; External References DBIA#
- ; ------------------- -----
- ; DIQ 2056
- ; PSOORRL,^TMP("PS",$J) 2400
- ; PSS50,^TMP($J 4483
- ;
- ; ------------ Get medications from VistA ------------
- ;
- EN(DFN,BEG,END,MAX,ID) ; -- find patient's meds
- N PS0,NHI,NHITM,IV K ^TMP("PS",$J)
- S DFN=+$G(DFN) Q:DFN<1
- S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
- ;
- ; get one med
- I $G(ID) D D:$D(NHITM)>9 XML(.NHITM) K ^TMP("PS",$J) Q
- . I ID["N" D NVA^NHINVPSO(ID,.NHITM) Q
- . I ID["O",(ID'["P")&(ID'["S") D RX^NHINVPSO(ID,.NHITM) Q
- . D OEL^PSOORRL(DFN,ID)
- . I ID["O",(ID["P")!(ID["S") D PEN1^NHINVPSO(ID,.NHITM) Q
- . S IV=$S(ID["V":1,$G(^TMP("PS",$J,"B",0)):1,1:0)
- . D @($S(IV:"IV1",1:"IN1")_"^NHINVPSI(ID,.NHITM)")
- ;
- ; get all meds
- D OCL^PSOORRL(DFN,BEG,END)
- S NHI=0 F S NHI=$O(^TMP("PS",$J,NHI)) Q:NHI<1!(NHI>MAX) S PS0=$G(^(NHI,0)) D I $D(NHITM)>9 D XML(.NHITM)
- . S ID=$P(PS0,U) K NHITM
- . I ID["N" D NVA^NHINVPSO(ID,.NHITM) Q
- . I ID["O" D RX^NHINVPSO(ID,.NHITM) Q
- . S IV=$S(ID["V":1,$G(^TMP("PS",$J,NHI,"B",0)):1,1:0)
- . D @($S(IV:"IV",1:"IN")_"^NHINVPSI(ID,.NHITM)")
- K ^TMP("PS",$J)
- Q
- ;
- NDF(DRUG,I) ; -- Set NDF data for dispense DRUG ien
- N VUID,X
- S DRUG=+$G(DRUG) Q:'DRUG
- D NDF^PSS50(DRUG,,,,,"NDF") S I=+$G(I)+1
- S MED("product",I)=DRUG_U_$G(^TMP($J,"NDF",DRUG,.01))_"^^D" ;Drug
- S X=$G(^TMP($J,"NDF",DRUG,20)),VUID=$$GET1^DIQ(50.6,+X_",",99.99)
- S MED("product",I,"G")=X_U_VUID ;VA Generic
- S X=$G(^TMP($J,"NDF",DRUG,22)),VUID=$$GET1^DIQ(50.68,+X_",",99.99)
- S MED("product",I,"P")=X_U_VUID ;VA Product
- S MED("product",I,"C")=$P($G(^TMP($J,"NDF",+DRUG,25)),U,3) ;display name
- K ^TMP($J,"NDF",DRUG)
- Q
- ;
- ; ------------ Return data to middle tier ------------
- ;
- XML(MED) ; -- Return patient meds as XML
- N ATT,X,Y,I,NAMES
- D ADD("<med>") S NHINTOTL=$G(NHINTOTL)+1
- S ATT="" F S ATT=$O(MED(ATT)) Q:ATT="" D I $L(Y) D ADD(Y)
- . I $O(MED(ATT,0)) D S Y="" Q ;multiples
- .. D ADD("<"_ATT_"s>")
- .. S I=0 F S I=$O(MED(ATT,I)) Q:I<1 D
- ... S X=$G(MED(ATT,I)),NAMES=""
- ... I ATT="dose" S NAMES="dose^units^unitsPerDose^noun^route^schedule^duration^conjunction^doseStart^doseStop^Z"
- ... I ATT="fill" S NAMES="fillDate^fillRouting^releaseDate^fillQuantity^fillDaysSupply^partial^Z"
- ... I ATT="product" S NAMES="code^name^vuid^role^concentration^Z"
- ... S Y="<"_ATT_" "_$$LOOP_$S(ATT'="product":"/>",1:">") D ADD(Y)
- ... Q:ATT'="product"
- ... S X=$G(MED(ATT,I,"C")) I $L(X) S Y="<class "_$$LOOP_"/>" D ADD(Y)
- ... S X=$G(MED(ATT,I,"G")) I $L(X) S Y="<vaGeneric "_$$LOOP_"/>" D ADD(Y)
- ... S X=$G(MED(ATT,I,"P")) I $L(X) S Y="<vaProduct "_$$LOOP_"/>" D ADD(Y)
- ... D ADD("</product>")
- .. D ADD("</"_ATT_"s>")
- . S X=$G(MED(ATT)),Y="" Q:'$L(X)
- . I ATT="sig"!(ATT?1"ptIn"1.A) S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
- . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
- . I $L(X)>1 S NAMES="code^name^Z",Y="<"_ATT_" "_$$LOOP_"/>"
- D ADD("</med>")
- 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[HNHINVPS 3405 printed Apr 23, 2025@18:31:54 Page 2
- NHINVPS ;SLC/MKB -- Pharmacy extract
- +1 ;;1.0;NHIN;**1**;Dec 01, 2009;Build 11
- +2 ;
- +3 ; External References DBIA#
- +4 ; ------------------- -----
- +5 ; DIQ 2056
- +6 ; PSOORRL,^TMP("PS",$J) 2400
- +7 ; PSS50,^TMP($J 4483
- +8 ;
- +9 ; ------------ Get medications from VistA ------------
- +10 ;
- EN(DFN,BEG,END,MAX,ID) ; -- find patient's meds
- +1 NEW PS0,NHI,NHITM,IV
- KILL ^TMP("PS",$JOB)
- +2 SET DFN=+$GET(DFN)
- if DFN<1
- QUIT
- +3 SET BEG=$GET(BEG,1410101)
- SET END=$GET(END,9999998)
- SET MAX=$GET(MAX,999999)
- +4 ;
- +5 ; get one med
- +6 IF $GET(ID)
- Begin DoDot:1
- +7 IF ID["N"
- DO NVA^NHINVPSO(ID,.NHITM)
- QUIT
- +8 IF ID["O"
- IF (ID'["P")&(ID'["S")
- DO RX^NHINVPSO(ID,.NHITM)
- QUIT
- +9 DO OEL^PSOORRL(DFN,ID)
- +10 IF ID["O"
- IF (ID["P")!(ID["S")
- DO PEN1^NHINVPSO(ID,.NHITM)
- QUIT
- +11 SET IV=$SELECT(ID["V":1,$GET(^TMP("PS",$JOB,"B",0)):1,1:0)
- +12 DO @($SELECT(IV:"IV1",1:"IN1")_"^NHINVPSI(ID,.NHITM)")
- End DoDot:1
- if $DATA(NHITM)>9
- DO XML(.NHITM)
- KILL ^TMP("PS",$JOB)
- QUIT
- +13 ;
- +14 ; get all meds
- +15 DO OCL^PSOORRL(DFN,BEG,END)
- +16 SET NHI=0
- FOR
- SET NHI=$ORDER(^TMP("PS",$JOB,NHI))
- if NHI<1!(NHI>MAX)
- QUIT
- SET PS0=$GET(^(NHI,0))
- Begin DoDot:1
- +17 SET ID=$PIECE(PS0,U)
- KILL NHITM
- +18 IF ID["N"
- DO NVA^NHINVPSO(ID,.NHITM)
- QUIT
- +19 IF ID["O"
- DO RX^NHINVPSO(ID,.NHITM)
- QUIT
- +20 SET IV=$SELECT(ID["V":1,$GET(^TMP("PS",$JOB,NHI,"B",0)):1,1:0)
- +21 DO @($SELECT(IV:"IV",1:"IN")_"^NHINVPSI(ID,.NHITM)")
- End DoDot:1
- IF $DATA(NHITM)>9
- DO XML(.NHITM)
- +22 KILL ^TMP("PS",$JOB)
- +23 QUIT
- +24 ;
- NDF(DRUG,I) ; -- Set NDF data for dispense DRUG ien
- +1 NEW VUID,X
- +2 SET DRUG=+$GET(DRUG)
- if 'DRUG
- QUIT
- +3 DO NDF^PSS50(DRUG,,,,,"NDF")
- SET I=+$GET(I)+1
- +4 ;Drug
- SET MED("product",I)=DRUG_U_$GET(^TMP($JOB,"NDF",DRUG,.01))_"^^D"
- +5 SET X=$GET(^TMP($JOB,"NDF",DRUG,20))
- SET VUID=$$GET1^DIQ(50.6,+X_",",99.99)
- +6 ;VA Generic
- SET MED("product",I,"G")=X_U_VUID
- +7 SET X=$GET(^TMP($JOB,"NDF",DRUG,22))
- SET VUID=$$GET1^DIQ(50.68,+X_",",99.99)
- +8 ;VA Product
- SET MED("product",I,"P")=X_U_VUID
- +9 ;display name
- SET MED("product",I,"C")=$PIECE($GET(^TMP($JOB,"NDF",+DRUG,25)),U,3)
- +10 KILL ^TMP($JOB,"NDF",DRUG)
- +11 QUIT
- +12 ;
- +13 ; ------------ Return data to middle tier ------------
- +14 ;
- XML(MED) ; -- Return patient meds as XML
- +1 NEW ATT,X,Y,I,NAMES
- +2 DO ADD("<med>")
- SET NHINTOTL=$GET(NHINTOTL)+1
- +3 SET ATT=""
- FOR
- SET ATT=$ORDER(MED(ATT))
- if ATT=""
- QUIT
- Begin DoDot:1
- +4 ;multiples
- IF $ORDER(MED(ATT,0))
- Begin DoDot:2
- +5 DO ADD("<"_ATT_"s>")
- +6 SET I=0
- FOR
- SET I=$ORDER(MED(ATT,I))
- if I<1
- QUIT
- Begin DoDot:3
- +7 SET X=$GET(MED(ATT,I))
- SET NAMES=""
- +8 IF ATT="dose"
- SET NAMES="dose^units^unitsPerDose^noun^route^schedule^duration^conjunction^doseStart^doseStop^Z"
- +9 IF ATT="fill"
- SET NAMES="fillDate^fillRouting^releaseDate^fillQuantity^fillDaysSupply^partial^Z"
- +10 IF ATT="product"
- SET NAMES="code^name^vuid^role^concentration^Z"
- +11 SET Y="<"_ATT_" "_$$LOOP_$S(ATT'="product":"/>",1:">")
- DO ADD(Y)
- +12 if ATT'="product"
- QUIT
- +13 SET X=$GET(MED(ATT,I,"C"))
- IF $LENGTH(X)
- SET Y="<class "_$$LOOP_"/>"
- DO ADD(Y)
- +14 SET X=$GET(MED(ATT,I,"G"))
- IF $LENGTH(X)
- SET Y="<vaGeneric "_$$LOOP_"/>"
- DO ADD(Y)
- +15 SET X=$GET(MED(ATT,I,"P"))
- IF $LENGTH(X)
- SET Y="<vaProduct "_$$LOOP_"/>"
- DO ADD(Y)
- +16 DO ADD("</product>")
- End DoDot:3
- +17 DO ADD("</"_ATT_"s>")
- End DoDot:2
- SET Y=""
- QUIT
- +18 SET X=$GET(MED(ATT))
- SET Y=""
- if '$LENGTH(X)
- QUIT
- +19 IF ATT="sig"!(ATT?1"ptIn"1.A)
- SET Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">"
- QUIT
- +20 IF X'["^"
- SET Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
- QUIT
- +21 IF $LENGTH(X)>1
- SET NAMES="code^name^Z"
- SET Y="<"_ATT_" "_$$LOOP_"/>"
- End DoDot:1
- IF $LENGTH(Y)
- DO ADD(Y)
- +22 DO ADD("</med>")
- +23 QUIT
- +24 ;
- 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
