HMPDPSOR ;SLC/MKB,ASMR/RRB,SRG - Medication extract by order;10/2/15 15:29
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^OR(100 5771
; ^ORD(100.98 873
; ^SC 10040
; ^VA(200 10060
; DIQ 2056
; ORCD 5493
; ORQ1,^TMP("ORR",$J) 3154
; ORX8 871,2467,3071
; PSOORRL,^TMP("PS",$J) 2400
; PSS50P7 4662
; PSS51P2 4548
;
Q
;----------- Get data from VistA --------------
;
STATUS(X) ; -- return HITSP status for 100.01 #X
S X=+$G(X) S:'X X=99 ;no status
I X=3 Q "hold"
I X=10!(X=11)!(X=5) Q "not active"
I X=1!(X=12)!(X=13) Q "not active"
I X=14!(X=99) Q "not active"
I X=2!(X=7)!(X=15) Q "historical"
Q "active"
;
RESP(ORIFN,RESP) ; -- return order responses [internal form]
N HMPDLG,I,J,W,ID,TYPE,X,Y
I '$D(ORDIALOG) S ORDIALOG=129 D GETDLG1^ORCD(129)
D GETORDER^ORCD(+$G(ORIFN),"HMPDLG")
S I=0 F S I=$O(HMPDLG(I)) Q:I<1 D
. S ID=$P($G(ORDIALOG(I)),U,2) Q:'$L(ID)
. S TYPE=$P($G(ORDIALOG(I,0)),U)
. S J=0 F S J=$O(HMPDLG(I,J)) Q:J<1 I $D(HMPDLG(I,J)) D
.. S X=HMPDLG(I,J) I TYPE'="W" S RESP(ID,J)=X Q
.. S Y=$G(@X@(1,0)),W=1 F S W=$O(@X@(W)) Q:W<1 S Y=Y_$S($E(Y,$L(Y))'=" ":" ",1:"")_$G(@X@(W,0))
.. S:$L(Y) RESP(ID,J)=Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDPSOR 1593 printed Sep 23, 2025@19:29:46 Page 2
HMPDPSOR ;SLC/MKB,ASMR/RRB,SRG - Medication extract by order;10/2/15 15:29
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^OR(100 5771
+7 ; ^ORD(100.98 873
+8 ; ^SC 10040
+9 ; ^VA(200 10060
+10 ; DIQ 2056
+11 ; ORCD 5493
+12 ; ORQ1,^TMP("ORR",$J) 3154
+13 ; ORX8 871,2467,3071
+14 ; PSOORRL,^TMP("PS",$J) 2400
+15 ; PSS50P7 4662
+16 ; PSS51P2 4548
+17 ;
+18 QUIT
+19 ;----------- Get data from VistA --------------
+20 ;
STATUS(X) ; -- return HITSP status for 100.01 #X
+1 ;no status
SET X=+$GET(X)
if 'X
SET X=99
+2 IF X=3
QUIT "hold"
+3 IF X=10!(X=11)!(X=5)
QUIT "not active"
+4 IF X=1!(X=12)!(X=13)
QUIT "not active"
+5 IF X=14!(X=99)
QUIT "not active"
+6 IF X=2!(X=7)!(X=15)
QUIT "historical"
+7 QUIT "active"
+8 ;
RESP(ORIFN,RESP) ; -- return order responses [internal form]
+1 NEW HMPDLG,I,J,W,ID,TYPE,X,Y
+2 IF '$DATA(ORDIALOG)
SET ORDIALOG=129
DO GETDLG1^ORCD(129)
+3 DO GETORDER^ORCD(+$GET(ORIFN),"HMPDLG")
+4 SET I=0
FOR
SET I=$ORDER(HMPDLG(I))
if I<1
QUIT
Begin DoDot:1
+5 SET ID=$PIECE($GET(ORDIALOG(I)),U,2)
if '$LENGTH(ID)
QUIT
+6 SET TYPE=$PIECE($GET(ORDIALOG(I,0)),U)
+7 SET J=0
FOR
SET J=$ORDER(HMPDLG(I,J))
if J<1
QUIT
IF $DATA(HMPDLG(I,J))
Begin DoDot:2
+8 SET X=HMPDLG(I,J)
IF TYPE'="W"
SET RESP(ID,J)=X
QUIT
+9 SET Y=$GET(@X@(1,0))
SET W=1
FOR
SET W=$ORDER(@X@(W))
if W<1
QUIT
SET Y=Y_$SELECT($EXTRACT(Y,$LENGTH(Y))'=" ":" ",1:"")_$GET(@X@(W,0))
+10 if $LENGTH(Y)
SET RESP(ID,J)=Y
End DoDot:2
End DoDot:1
+11 QUIT
