NHINVPSO ;SLC/MKB -- Outpatient Pharmacy extract
;;1.0;NHIN;**1**;Dec 01, 2009;Build 11
;
; External References DBIA#
; ------------------- -----
; ^SC 10040
; ^VA(200) 10060
; DIQ 2056
; ORX8 2467
; PSO5241 4821
; PSOORDER,^TMP("PSOR",$J) 1878
; PSOORRL,^TMP("PS",$J) 2400
; PSS50P7 4662
; PSS51P2 4548
; XLFDT 10103
;
; ------------ Get medications from VistA ------------
;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's meds
N PS0,NHI,NHITM 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^NHINVPS(.NHITM) Q
. Q:ID["I"
. I ID["N" D NVA(ID,.NHITM) Q
. I ID'["P",ID'["S" D RX(ID,.NHITM) Q
. D OEL^PSOORRL(DFN,ID),PEN1(ID,.NHITM)
. K ^TMP("PS",$J)
;
; 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^NHINVPS(.NHITM)
. S ID=$P(PS0,U) K NHITM Q:ID["I"
. I ID["N" D NVA(ID,.NHITM) Q
. I ID["O" D RX(ID,.NHITM) Q
K ^TMP("PS",$J)
Q
;
RX(ID,MED) ; -- return a prescription in MED("attribute")=value
I ID["P"!(ID["S") G PEND ;pending order
N RX0,RX1,DRUG,PSOI,X,I,START,STOP,ORIFN,FILL,RFD,PRV K MED
K ^TMP("PSOR",$J) D EN^PSOORDER(DFN,+ID)
S RX0=$G(^TMP("PSOR",$J,+ID,0)),RX1=$G(^(1)),DRUG=$G(^("DRUG",0))
S MED("id")=ID,MED("vaType")="O",MED("type")="Prescription"
S ORIFN=+$P(RX1,U,8) S:ORIFN MED("orderID")=ORIFN
S PSOI=$G(^TMP("PSOR",$J,+ID,"DRUGOI",0)) I PSOI D
. S MED("name")=$P(PSOI,";",2)
. D ZERO^PSS50P7(+PSOI,,,"OI")
. S MED("form")=$P($G(^TMP($J,"OI",+PSOI,.02)),U,2)
D:DRUG NDF^NHINVPS(+DRUG) ;add NDF data
S START=$P(RX0,U) S:START MED("start")=START
S STOP=$P(RX0,U,12) S:STOP MED("stop")=STOP ;_".2359"?
S X=$$GET1^DIQ(52,+ID_",",26,"I") S:X MED("expires")=X
S X=$P(RX0,U,17) S:X MED("ordered")=X
S MED("vaStatus")=$P($P(RX0,U,4),";",2),X=$P($P(RX0,U,4),";")
S MED("status")=$S(X="H":"hold",X="DC":"not active",X="D"!(X="E"):"historical",1:"active")
S MED("quantity")=$P(RX0,U,6),MED("daysSupply")=$P(RX0,U,7)
S MED("fillsAllowed")=$P(RX0,U,8),MED("fillsRemaining")=$P(RX0,U,9)
S MED("routing")=$P($P(RX1,U,6),";"),MED("prescription")=$P(RX0,U,5)
S MED("lastFilled")=$P(RX0,U,3) K FILL
S I=0 F S I=$O(^TMP("PSOR",$J,+ID,"REF",I)) Q:I<1 S X=$G(^(I,0)),FILL(+X)=X
S I=0 F S I=$O(^TMP("PSOR",$J,+ID,"RPAR",I)) Q:I<1 S X=$G(^(I,0)),$P(X,U,14)=1,FILL(+X)=X
S (I,RFD,PRV)=0 F S RFD=$O(FILL(RFD)) Q:RFD<1 S X=$G(FILL(RFD)) D ;sort 1st
. N MW,REL S I=I+1
. S MW=$P($P(X,U,10),";"),REL=$P($P(X,U,8),".")
. S MED("fill",I)=$P(RFD,".")_U_MW_U_REL_U_$P(X,U,4,5)_$S($P(X,U,14):"^1",1:"")
. S:$P(X,U,2) PRV=$P(X,U,2) ;save last provider
. ; fill comments?
S X=$S($P(RX0,U,11):$P(RX0,U,11),$P(RX0,U,10):$P(RX0,U,10),1:0)
S:X MED("fillCost")=X
S X=$G(^TMP("PSOR",$J,+ID,"SIG",1,0)),I=1
F S I=$O(^TMP("PSOR",$J,+ID,"SIG",I)) Q:I<1 S X=X_$G(^(I,0))
S MED("sig")=X
S X=$G(^TMP("PSOR",$J,+ID,"PI",1,0)),I=1
F S I=$O(^TMP("PSOR",$J,+ID,"PI",I)) Q:I<1 S X=X_$G(^(I,0))
S:$L(X) MED("ptInstructions")=X
S I=0 F S I=$O(^TMP("PSOR",$J,+ID,"MI",I)) Q:I<1 S X=$G(^(I,0)) D
. N UD,NOUN,DOSE,UNIT,RTE,SCH,DUR,CONJ,END
. S UD=$P(X,U,2),NOUN=$P(X,U,4)
. S DOSE=$P(X,U),UNIT=$P($P(X,U,3),";",2)
. S RTE=+$P(X,U,7) D ALL^PSS51P2(RTE,,,,"MR")
. S RTE=$G(^TMP($J,"MR",RTE,1))
. S DUR=$P(X,U,5),CONJ=$P(X,U,6),SCH=$P(X,U,8)
. S END=$S(DUR:$$STOP(START,DUR),1:STOP)
. S MED("dose",I)=DOSE_U_UNIT_U_UD_U_NOUN_U_RTE_U_SCH_U_DUR_U_CONJ_U_START_U_STOP
. I $E(CONJ)="T",DUR S START=END
S:RX1 X=$TR($P(RX1,U),";","^"),MED("orderingProvider")=X,MED("currentProvider")=X
S:$G(PRV) MED("currentProvider")=$TR(PRV,";","^")
S:$P(RX1,U,9) MED("pharmacist")=$TR($P(RX1,U,9),";","^")
S:$P(RX1,U,4) MED("location")=$TR($P(RX1,U,4),";","^")
S MED("facility")=$$FAC^NHINV(+$P(RX1,U,4))
K ^TMP("PSOR",$J),^TMP($J,"MR"),^TMP($J,"NDF"),^TMP($J,"OI")
Q
;
PEND ; -- pending prescription
; [expects PS0,OCL^PSOORRL data]
N I,X,NHIN K MED
S MED("id")=ID,MED("vaType")="O",MED("type")="Prescription"
S MED("vaStatus")=$P(PS0,U,9),MED("status")="not active"
S X=+$P(PS0,U,8) S:X MED("orderID")=X
S X=+$P(PS0,U,12) S:X MED("quantity")=X
D GETS^DIQ(52.41,+ID_",","101;13;19;15;5;1.1","I","NHIN")
S X=NHIN(52.41,+ID_",",101,"I") S:X MED("daysSupply")=X
S X=NHIN(52.41,+ID_",",13,"I") S:X MED("fillsAllowed")=X
S X=NHIN(52.41,+ID_",",19,"I") S:$L(X) MED("routing")=X
S X=NHIN(52.41,+ID_",",15,"I") S:X MED("ordered")=X
S X=NHIN(52.41,+ID_",",5,"I") S:X MED("orderingProvider")=X_U_$P($G(^VA(200,X,0)),U)
S X=NHIN(52.41,+ID_",",1.1,"I") S:X MED("location")=X_U_$P($G(^SC(X,0)),U)
S MED("facility")=$$FAC^NHINV(X)
S X=$G(^TMP("PS",$J,NHI,"SIG",1,0)),I=1
F S I=$O(^TMP("PS",$J,NHI,"SIG",I)) Q:I<1 S X=X_$C(13,10)_$G(^(I,0))
S MED("sig")=X
D PEN^PSO5241(DFN,"NHIN",+ID)
S X=$G(^TMP($J,"NHIN",DFN,+ID,8)) I X D ;Pharmacy OI
. S MED("name")=$P(X,U,2)_" "_$P(X,U,4),MED("form")=$P(X,U,4)
S X=$G(^TMP($J,"NHIN",DFN,+ID,11)) D:X NDF^NHINVPS(+X) ;Dispense Drug
D PDOSE K ^TMP($J,"NHIN")
Q
;
PEN1(ID,MED) ; -- return a pending Rx in MED("attribute")=value
; [expects OEL^PSOORRL data]
N PS,PS0,I,X,NHIN K MED
M PS=^TMP("PS",$J) S PS0=PS(0)
S MED("id")=ID,MED("vaType")="O",MED("type")="Prescription"
S MED("vaStatus")=$P(PS0,U,6),MED("status")="not active"
S X=+$P(PS0,U,11) S:X MED("orderID")=X
S X=+$P(PS0,U,8) S:X MED("quantity")=X
S X=+$P(PS0,U,4) S:X MED("fillsAllowed")=X
S X=+$P(PS0,U,5) S:X MED("ordered")=X
S X=$G(PS("DD",1,0)) D:X NDF^NHINVPS(+X) ;Dispense Drug
D GETS^DIQ(52.41,+ID_",","101;19;5;1.1","I","NHIN")
S X=NHIN(52.41,+ID_",",101,"I") S:X MED("daysSupply")=X
S X=NHIN(52.41,+ID_",",19,"I") S:$L(X) MED("routing")=X
S X=NHIN(52.41,+ID_",",5,"I") S:X MED("orderingProvider")=X_U_$P($G(^VA(200,X,0)),U)
S X=NHIN(52.41,+ID_",",1.1,"I") S:X MED("location")=X_U_$P($G(^SC(X,0)),U)
S MED("facility")=$$FAC^NHINV(X)
S X=$G(PS("SIG",1,0)),I=1
F S I=$O(PS("SIG",I)) Q:I<1 S X=X_$C(13,10)_$G(PS("SIG",I,0))
S MED("sig")=X
D PEN^PSO5241(DFN,"NHIN",+ID)
S X=$G(^TMP($J,"NHIN",DFN,+ID,8)) I X D ;Pharmacy OI
. S MED("name")=$P(X,U,2)_" "_$P(X,U,4),MED("form")=$P(X,U,4)
D PDOSE K ^TMP($J,"NHIN")
Q
;
PDOSE ; Pending file doses
N QT,UNIT,UD,NOUN,DOSE,RTE,SCH,DUR,CONJ,BEG,END
F I=1:1 K NHIN D GETS^DIQ(52.413,I_","_+ID_",","*",,"NHIN") Q:'$D(NHIN) D
. K QT M QT=NHIN(52.413,I_","_+ID_",")
. S (UNIT,UD,NOUN)="",(DOSE,X)=QT(.01) I X["&" D
.. S DOSE=$P(X,"&"),UNIT=$P(X,"&",2)
.. S UD=$P(X,"&",3),NOUN=$P(X,"&",4)
. S SCH=QT(1),DUR=QT(2),CONJ=QT(6),BEG=QT(3),END=QT(4)
. S RTE=$$GET1^DIQ(52.413,I_","_+ID_",","10:1")
. S MED("dose",I)=DOSE_U_UNIT_U_UD_U_NOUN_U_RTE_U_SCH_U_DUR_U_CONJ_U_BEG_U_END
Q
;
STOP(BEG,X) ; -- Return date after adding X to BEG
N D,H,M,S,UNT,Y
S Y=BEG,(D,H,M,S)=0,UNT=$P(X," ",2),X=+X
S:UNT?1"MON".E D=30*X
S:UNT?1"WEE".E D=7*X
S:UNT?1"DAY".E D=X
S:UNT?1"HOU".E H=X
S:UNT?1"MIN".E M=X
S:UNT?1"SEC".E S=X
S Y=$$FMADD^XLFDT(BEG,D,H,M,S)
Q Y
;
NVA(ID,MED) ; -- return a non-VA med in MED("attribute")=value
N NVA,NHZ,ORIFN,DOSE,X K MED
D GETS^DIQ(55.05,+ID_","_DFN_",",".01:8;11:13","IE","NHZ")
M NVA=NHZ(55.05,+ID_","_DFN_",") K NHZ
S MED("id")=ID,MED("type")="OTC",MED("vaType")="N"
S ORIFN=+NVA(7,"I") S:ORIFN MED("orderID")=ORIFN
I NVA(.01,"I") D ;orderable item
. N FORM
. S X=NVA(.01,"I") D ZERO^PSS50P7(+X,,,"PSOI")
. S FORM=$P($G(^TMP($J,"PSOI",+X,.02)),U,2),MED("form")=FORM
. S MED("name")=NVA(.01,"E")_" "_FORM
S X=NVA(1,"I") D:X NDF^NHINVPS(+X) ;dispense drug
S MED("sig")=NVA(2,"E")_" BY "_NVA(3,"E")_" "_NVA(4,"E")
S X=NVA(2,"I"),NVA(2,"I")=+X_U_$P(X,+X,2) ;amt^unit
S DOSE=NVA(2,"I")_"^^" I ORIFN D ;reformat from order
. S X=$$VALUE^ORX8(ORIFN,"ROUTE") S:X NVA(3,"E")=$$GET1^DIQ(51.2,+X_",",1)
. S X=$$VALUE^ORX8(ORIFN,"SCHEDULE") S:$L(X) NVA(4,"E")=X
. S X=$$VALUE^ORX8(ORIFN,"DOSE"),DOSE=$TR($P(X,"&",1,4),"&","^")
S MED("dose",1)=DOSE_U_NVA(3,"E")_U_NVA(4,"E")
S:NVA(8,"I") MED("start")=NVA(8,"I")
S:NVA(6,"I") MED("stop")=NVA(6,"I")
S:NVA(11,"I") MED("ordered")=NVA(11,"I")
S MED("status")=$S($G(NVA(5,"E")):"not active",1:"active")
S:NVA(12,"I") MED("orderingProvider")=NVA(12,"I")_U_NVA(12,"E")
S:NVA(13,"I") MED("location")=NVA(13,"I")_U_NVA(13,"E")
S MED("facility")=$$FAC^NHINV(NVA(13,"I"))
K ^TMP($J,"PSOI"),^TMP($J,"NDF")
Q
;
ACTIVE(X) ; -- return 1 or 0, if X is an active status
N Y S Y=1
I X="PURGE" S Y=0
I X="DELETED" S Y=0
I X="EXPIRED" S Y=0 ;keep, to renew?
I $P(X," ")="DISCONTINUED" S Y=0
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNHINVPSO 8915 printed Sep 23, 2025@19:53:47 Page 2
NHINVPSO ;SLC/MKB -- Outpatient Pharmacy extract
+1 ;;1.0;NHIN;**1**;Dec 01, 2009;Build 11
+2 ;
+3 ; External References DBIA#
+4 ; ------------------- -----
+5 ; ^SC 10040
+6 ; ^VA(200) 10060
+7 ; DIQ 2056
+8 ; ORX8 2467
+9 ; PSO5241 4821
+10 ; PSOORDER,^TMP("PSOR",$J) 1878
+11 ; PSOORRL,^TMP("PS",$J) 2400
+12 ; PSS50P7 4662
+13 ; PSS51P2 4548
+14 ; XLFDT 10103
+15 ;
+16 ; ------------ Get medications from VistA ------------
+17 ;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's meds
+1 NEW PS0,NHI,NHITM
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["I"
QUIT
+8 IF ID["N"
DO NVA(ID,.NHITM)
QUIT
+9 IF ID'["P"
IF ID'["S"
DO RX(ID,.NHITM)
QUIT
+10 DO OEL^PSOORRL(DFN,ID)
DO PEN1(ID,.NHITM)
+11 KILL ^TMP("PS",$JOB)
End DoDot:1
if $DATA(NHITM)>9
DO XML^NHINVPS(.NHITM)
QUIT
+12 ;
+13 ; get all meds
+14 DO OCL^PSOORRL(DFN,BEG,END)
+15 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
+16 SET ID=$PIECE(PS0,U)
KILL NHITM
if ID["I"
QUIT
+17 IF ID["N"
DO NVA(ID,.NHITM)
QUIT
+18 IF ID["O"
DO RX(ID,.NHITM)
QUIT
End DoDot:1
IF $DATA(NHITM)>9
DO XML^NHINVPS(.NHITM)
+19 KILL ^TMP("PS",$JOB)
+20 QUIT
+21 ;
RX(ID,MED) ; -- return a prescription in MED("attribute")=value
+1 ;pending order
IF ID["P"!(ID["S")
GOTO PEND
+2 NEW RX0,RX1,DRUG,PSOI,X,I,START,STOP,ORIFN,FILL,RFD,PRV
KILL MED
+3 KILL ^TMP("PSOR",$JOB)
DO EN^PSOORDER(DFN,+ID)
+4 SET RX0=$GET(^TMP("PSOR",$JOB,+ID,0))
SET RX1=$GET(^(1))
SET DRUG=$GET(^("DRUG",0))
+5 SET MED("id")=ID
SET MED("vaType")="O"
SET MED("type")="Prescription"
+6 SET ORIFN=+$PIECE(RX1,U,8)
if ORIFN
SET MED("orderID")=ORIFN
+7 SET PSOI=$GET(^TMP("PSOR",$JOB,+ID,"DRUGOI",0))
IF PSOI
Begin DoDot:1
+8 SET MED("name")=$PIECE(PSOI,";",2)
+9 DO ZERO^PSS50P7(+PSOI,,,"OI")
+10 SET MED("form")=$PIECE($GET(^TMP($JOB,"OI",+PSOI,.02)),U,2)
End DoDot:1
+11 ;add NDF data
if DRUG
DO NDF^NHINVPS(+DRUG)
+12 SET START=$PIECE(RX0,U)
if START
SET MED("start")=START
+13 ;_".2359"?
SET STOP=$PIECE(RX0,U,12)
if STOP
SET MED("stop")=STOP
+14 SET X=$$GET1^DIQ(52,+ID_",",26,"I")
if X
SET MED("expires")=X
+15 SET X=$PIECE(RX0,U,17)
if X
SET MED("ordered")=X
+16 SET MED("vaStatus")=$PIECE($PIECE(RX0,U,4),";",2)
SET X=$PIECE($PIECE(RX0,U,4),";")
+17 SET MED("status")=$SELECT(X="H":"hold",X="DC":"not active",X="D"!(X="E"):"historical",1:"active")
+18 SET MED("quantity")=$PIECE(RX0,U,6)
SET MED("daysSupply")=$PIECE(RX0,U,7)
+19 SET MED("fillsAllowed")=$PIECE(RX0,U,8)
SET MED("fillsRemaining")=$PIECE(RX0,U,9)
+20 SET MED("routing")=$PIECE($PIECE(RX1,U,6),";")
SET MED("prescription")=$PIECE(RX0,U,5)
+21 SET MED("lastFilled")=$PIECE(RX0,U,3)
KILL FILL
+22 SET I=0
FOR
SET I=$ORDER(^TMP("PSOR",$JOB,+ID,"REF",I))
if I<1
QUIT
SET X=$GET(^(I,0))
SET FILL(+X)=X
+23 SET I=0
FOR
SET I=$ORDER(^TMP("PSOR",$JOB,+ID,"RPAR",I))
if I<1
QUIT
SET X=$GET(^(I,0))
SET $PIECE(X,U,14)=1
SET FILL(+X)=X
+24 ;sort 1st
SET (I,RFD,PRV)=0
FOR
SET RFD=$ORDER(FILL(RFD))
if RFD<1
QUIT
SET X=$GET(FILL(RFD))
Begin DoDot:1
+25 NEW MW,REL
SET I=I+1
+26 SET MW=$PIECE($PIECE(X,U,10),";")
SET REL=$PIECE($PIECE(X,U,8),".")
+27 SET MED("fill",I)=$PIECE(RFD,".")_U_MW_U_REL_U_$PIECE(X,U,4,5)_$SELECT($PIECE(X,U,14):"^1",1:"")
+28 ;save last provider
if $PIECE(X,U,2)
SET PRV=$PIECE(X,U,2)
+29 ; fill comments?
End DoDot:1
+30 SET X=$SELECT($PIECE(RX0,U,11):$PIECE(RX0,U,11),$PIECE(RX0,U,10):$PIECE(RX0,U,10),1:0)
+31 if X
SET MED("fillCost")=X
+32 SET X=$GET(^TMP("PSOR",$JOB,+ID,"SIG",1,0))
SET I=1
+33 FOR
SET I=$ORDER(^TMP("PSOR",$JOB,+ID,"SIG",I))
if I<1
QUIT
SET X=X_$GET(^(I,0))
+34 SET MED("sig")=X
+35 SET X=$GET(^TMP("PSOR",$JOB,+ID,"PI",1,0))
SET I=1
+36 FOR
SET I=$ORDER(^TMP("PSOR",$JOB,+ID,"PI",I))
if I<1
QUIT
SET X=X_$GET(^(I,0))
+37 if $LENGTH(X)
SET MED("ptInstructions")=X
+38 SET I=0
FOR
SET I=$ORDER(^TMP("PSOR",$JOB,+ID,"MI",I))
if I<1
QUIT
SET X=$GET(^(I,0))
Begin DoDot:1
+39 NEW UD,NOUN,DOSE,UNIT,RTE,SCH,DUR,CONJ,END
+40 SET UD=$PIECE(X,U,2)
SET NOUN=$PIECE(X,U,4)
+41 SET DOSE=$PIECE(X,U)
SET UNIT=$PIECE($PIECE(X,U,3),";",2)
+42 SET RTE=+$PIECE(X,U,7)
DO ALL^PSS51P2(RTE,,,,"MR")
+43 SET RTE=$GET(^TMP($JOB,"MR",RTE,1))
+44 SET DUR=$PIECE(X,U,5)
SET CONJ=$PIECE(X,U,6)
SET SCH=$PIECE(X,U,8)
+45 SET END=$SELECT(DUR:$$STOP(START,DUR),1:STOP)
+46 SET MED("dose",I)=DOSE_U_UNIT_U_UD_U_NOUN_U_RTE_U_SCH_U_DUR_U_CONJ_U_START_U_STOP
+47 IF $EXTRACT(CONJ)="T"
IF DUR
SET START=END
End DoDot:1
+48 if RX1
SET X=$TRANSLATE($PIECE(RX1,U),";","^")
SET MED("orderingProvider")=X
SET MED("currentProvider")=X
+49 if $GET(PRV)
SET MED("currentProvider")=$TRANSLATE(PRV,";","^")
+50 if $PIECE(RX1,U,9)
SET MED("pharmacist")=$TRANSLATE($PIECE(RX1,U,9),";","^")
+51 if $PIECE(RX1,U,4)
SET MED("location")=$TRANSLATE($PIECE(RX1,U,4),";","^")
+52 SET MED("facility")=$$FAC^NHINV(+$PIECE(RX1,U,4))
+53 KILL ^TMP("PSOR",$JOB),^TMP($JOB,"MR"),^TMP($JOB,"NDF"),^TMP($JOB,"OI")
+54 QUIT
+55 ;
PEND ; -- pending prescription
+1 ; [expects PS0,OCL^PSOORRL data]
+2 NEW I,X,NHIN
KILL MED
+3 SET MED("id")=ID
SET MED("vaType")="O"
SET MED("type")="Prescription"
+4 SET MED("vaStatus")=$PIECE(PS0,U,9)
SET MED("status")="not active"
+5 SET X=+$PIECE(PS0,U,8)
if X
SET MED("orderID")=X
+6 SET X=+$PIECE(PS0,U,12)
if X
SET MED("quantity")=X
+7 DO GETS^DIQ(52.41,+ID_",","101;13;19;15;5;1.1","I","NHIN")
+8 SET X=NHIN(52.41,+ID_",",101,"I")
if X
SET MED("daysSupply")=X
+9 SET X=NHIN(52.41,+ID_",",13,"I")
if X
SET MED("fillsAllowed")=X
+10 SET X=NHIN(52.41,+ID_",",19,"I")
if $LENGTH(X)
SET MED("routing")=X
+11 SET X=NHIN(52.41,+ID_",",15,"I")
if X
SET MED("ordered")=X
+12 SET X=NHIN(52.41,+ID_",",5,"I")
if X
SET MED("orderingProvider")=X_U_$PIECE($GET(^VA(200,X,0)),U)
+13 SET X=NHIN(52.41,+ID_",",1.1,"I")
if X
SET MED("location")=X_U_$PIECE($GET(^SC(X,0)),U)
+14 SET MED("facility")=$$FAC^NHINV(X)
+15 SET X=$GET(^TMP("PS",$JOB,NHI,"SIG",1,0))
SET I=1
+16 FOR
SET I=$ORDER(^TMP("PS",$JOB,NHI,"SIG",I))
if I<1
QUIT
SET X=X_$CHAR(13,10)_$GET(^(I,0))
+17 SET MED("sig")=X
+18 DO PEN^PSO5241(DFN,"NHIN",+ID)
+19 ;Pharmacy OI
SET X=$GET(^TMP($JOB,"NHIN",DFN,+ID,8))
IF X
Begin DoDot:1
+20 SET MED("name")=$PIECE(X,U,2)_" "_$PIECE(X,U,4)
SET MED("form")=$PIECE(X,U,4)
End DoDot:1
+21 ;Dispense Drug
SET X=$GET(^TMP($JOB,"NHIN",DFN,+ID,11))
if X
DO NDF^NHINVPS(+X)
+22 DO PDOSE
KILL ^TMP($JOB,"NHIN")
+23 QUIT
+24 ;
PEN1(ID,MED) ; -- return a pending Rx in MED("attribute")=value
+1 ; [expects OEL^PSOORRL data]
+2 NEW PS,PS0,I,X,NHIN
KILL MED
+3 MERGE PS=^TMP("PS",$JOB)
SET PS0=PS(0)
+4 SET MED("id")=ID
SET MED("vaType")="O"
SET MED("type")="Prescription"
+5 SET MED("vaStatus")=$PIECE(PS0,U,6)
SET MED("status")="not active"
+6 SET X=+$PIECE(PS0,U,11)
if X
SET MED("orderID")=X
+7 SET X=+$PIECE(PS0,U,8)
if X
SET MED("quantity")=X
+8 SET X=+$PIECE(PS0,U,4)
if X
SET MED("fillsAllowed")=X
+9 SET X=+$PIECE(PS0,U,5)
if X
SET MED("ordered")=X
+10 ;Dispense Drug
SET X=$GET(PS("DD",1,0))
if X
DO NDF^NHINVPS(+X)
+11 DO GETS^DIQ(52.41,+ID_",","101;19;5;1.1","I","NHIN")
+12 SET X=NHIN(52.41,+ID_",",101,"I")
if X
SET MED("daysSupply")=X
+13 SET X=NHIN(52.41,+ID_",",19,"I")
if $LENGTH(X)
SET MED("routing")=X
+14 SET X=NHIN(52.41,+ID_",",5,"I")
if X
SET MED("orderingProvider")=X_U_$PIECE($GET(^VA(200,X,0)),U)
+15 SET X=NHIN(52.41,+ID_",",1.1,"I")
if X
SET MED("location")=X_U_$PIECE($GET(^SC(X,0)),U)
+16 SET MED("facility")=$$FAC^NHINV(X)
+17 SET X=$GET(PS("SIG",1,0))
SET I=1
+18 FOR
SET I=$ORDER(PS("SIG",I))
if I<1
QUIT
SET X=X_$CHAR(13,10)_$GET(PS("SIG",I,0))
+19 SET MED("sig")=X
+20 DO PEN^PSO5241(DFN,"NHIN",+ID)
+21 ;Pharmacy OI
SET X=$GET(^TMP($JOB,"NHIN",DFN,+ID,8))
IF X
Begin DoDot:1
+22 SET MED("name")=$PIECE(X,U,2)_" "_$PIECE(X,U,4)
SET MED("form")=$PIECE(X,U,4)
End DoDot:1
+23 DO PDOSE
KILL ^TMP($JOB,"NHIN")
+24 QUIT
+25 ;
PDOSE ; Pending file doses
+1 NEW QT,UNIT,UD,NOUN,DOSE,RTE,SCH,DUR,CONJ,BEG,END
+2 FOR I=1:1
KILL NHIN
DO GETS^DIQ(52.413,I_","_+ID_",","*",,"NHIN")
if '$DATA(NHIN)
QUIT
Begin DoDot:1
+3 KILL QT
MERGE QT=NHIN(52.413,I_","_+ID_",")
+4 SET (UNIT,UD,NOUN)=""
SET (DOSE,X)=QT(.01)
IF X["&"
Begin DoDot:2
+5 SET DOSE=$PIECE(X,"&")
SET UNIT=$PIECE(X,"&",2)
+6 SET UD=$PIECE(X,"&",3)
SET NOUN=$PIECE(X,"&",4)
End DoDot:2
+7 SET SCH=QT(1)
SET DUR=QT(2)
SET CONJ=QT(6)
SET BEG=QT(3)
SET END=QT(4)
+8 SET RTE=$$GET1^DIQ(52.413,I_","_+ID_",","10:1")
+9 SET MED("dose",I)=DOSE_U_UNIT_U_UD_U_NOUN_U_RTE_U_SCH_U_DUR_U_CONJ_U_BEG_U_END
End DoDot:1
+10 QUIT
+11 ;
STOP(BEG,X) ; -- Return date after adding X to BEG
+1 NEW D,H,M,S,UNT,Y
+2 SET Y=BEG
SET (D,H,M,S)=0
SET UNT=$PIECE(X," ",2)
SET X=+X
+3 if UNT?1"MON".E
SET D=30*X
+4 if UNT?1"WEE".E
SET D=7*X
+5 if UNT?1"DAY".E
SET D=X
+6 if UNT?1"HOU".E
SET H=X
+7 if UNT?1"MIN".E
SET M=X
+8 if UNT?1"SEC".E
SET S=X
+9 SET Y=$$FMADD^XLFDT(BEG,D,H,M,S)
+10 QUIT Y
+11 ;
NVA(ID,MED) ; -- return a non-VA med in MED("attribute")=value
+1 NEW NVA,NHZ,ORIFN,DOSE,X
KILL MED
+2 DO GETS^DIQ(55.05,+ID_","_DFN_",",".01:8;11:13","IE","NHZ")
+3 MERGE NVA=NHZ(55.05,+ID_","_DFN_",")
KILL NHZ
+4 SET MED("id")=ID
SET MED("type")="OTC"
SET MED("vaType")="N"
+5 SET ORIFN=+NVA(7,"I")
if ORIFN
SET MED("orderID")=ORIFN
+6 ;orderable item
IF NVA(.01,"I")
Begin DoDot:1
+7 NEW FORM
+8 SET X=NVA(.01,"I")
DO ZERO^PSS50P7(+X,,,"PSOI")
+9 SET FORM=$PIECE($GET(^TMP($JOB,"PSOI",+X,.02)),U,2)
SET MED("form")=FORM
+10 SET MED("name")=NVA(.01,"E")_" "_FORM
End DoDot:1
+11 ;dispense drug
SET X=NVA(1,"I")
if X
DO NDF^NHINVPS(+X)
+12 SET MED("sig")=NVA(2,"E")_" BY "_NVA(3,"E")_" "_NVA(4,"E")
+13 ;amt^unit
SET X=NVA(2,"I")
SET NVA(2,"I")=+X_U_$PIECE(X,+X,2)
+14 ;reformat from order
SET DOSE=NVA(2,"I")_"^^"
IF ORIFN
Begin DoDot:1
+15 SET X=$$VALUE^ORX8(ORIFN,"ROUTE")
if X
SET NVA(3,"E")=$$GET1^DIQ(51.2,+X_",",1)
+16 SET X=$$VALUE^ORX8(ORIFN,"SCHEDULE")
if $LENGTH(X)
SET NVA(4,"E")=X
+17 SET X=$$VALUE^ORX8(ORIFN,"DOSE")
SET DOSE=$TRANSLATE($PIECE(X,"&",1,4),"&","^")
End DoDot:1
+18 SET MED("dose",1)=DOSE_U_NVA(3,"E")_U_NVA(4,"E")
+19 if NVA(8,"I")
SET MED("start")=NVA(8,"I")
+20 if NVA(6,"I")
SET MED("stop")=NVA(6,"I")
+21 if NVA(11,"I")
SET MED("ordered")=NVA(11,"I")
+22 SET MED("status")=$SELECT($GET(NVA(5,"E")):"not active",1:"active")
+23 if NVA(12,"I")
SET MED("orderingProvider")=NVA(12,"I")_U_NVA(12,"E")
+24 if NVA(13,"I")
SET MED("location")=NVA(13,"I")_U_NVA(13,"E")
+25 SET MED("facility")=$$FAC^NHINV(NVA(13,"I"))
+26 KILL ^TMP($JOB,"PSOI"),^TMP($JOB,"NDF")
+27 QUIT
+28 ;
ACTIVE(X) ; -- return 1 or 0, if X is an active status
+1 NEW Y
SET Y=1
+2 IF X="PURGE"
SET Y=0
+3 IF X="DELETED"
SET Y=0
+4 ;keep, to renew?
IF X="EXPIRED"
SET Y=0
+5 IF $PIECE(X," ")="DISCONTINUED"
SET Y=0
+6 QUIT Y
