VPRP24 ;SLC/MKB -- SDA utilities for patch 24 ;11/8/18 14:11
;;1.0;VIRTUAL PATIENT RECORD;**24**;Sep 01, 2011;Build 3
;;Per VHA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^ORD(100.98 6982
; ORQ1, ^TMP("ORR",$J 3154
; XLFSTR 10104
;
POST ; -- postinit
;D PCMM^VPRIDX
Q
;
; The following api's support the P24 Partial Load entities:
;
RXQ ; -- find active Rx where Sig'[PI
N ORDG,ORLIST,VPRI,VPRN,ORDER,SIG,PI
S ORDG=+$O(^ORD(100.98,"B","O RX",0))
D EN^ORQ1(DFN_";DPT(",ORDG,2) S VPRN=0
S VPRI=0 F S VPRI=$O(^TMP("ORR",$J,ORLIST,VPRI)) Q:VPRI<1 S ORDER=$G(^(VPRI)) D Q:VPRN'<DMAX
. S PI=$$WP^VPRSDA(+ORDER,"PI") Q:PI=""
. S SIG=$$WP^VPRSDA(+ORDER,"SIG") Q:SIG[PI
. S SIG=$$UP^XLFSTR(SIG),PI=$$UP^XLFSTR(PI)
. S PI=$$TRIM^XLFSTR(PI) Q:SIG[PI
. S VPRN=VPRN+1,DLIST(VPRN)=+ORDER
K ^TMP("ORR",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRP24 988 printed Dec 13, 2024@02:45:33 Page 2
VPRP24 ;SLC/MKB -- SDA utilities for patch 24 ;11/8/18 14:11
+1 ;;1.0;VIRTUAL PATIENT RECORD;**24**;Sep 01, 2011;Build 3
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^ORD(100.98 6982
+7 ; ORQ1, ^TMP("ORR",$J 3154
+8 ; XLFSTR 10104
+9 ;
POST ; -- postinit
+1 ;D PCMM^VPRIDX
+2 QUIT
+3 ;
+4 ; The following api's support the P24 Partial Load entities:
+5 ;
RXQ ; -- find active Rx where Sig'[PI
+1 NEW ORDG,ORLIST,VPRI,VPRN,ORDER,SIG,PI
+2 SET ORDG=+$ORDER(^ORD(100.98,"B","O RX",0))
+3 DO EN^ORQ1(DFN_";DPT(",ORDG,2)
SET VPRN=0
+4 SET VPRI=0
FOR
SET VPRI=$ORDER(^TMP("ORR",$JOB,ORLIST,VPRI))
if VPRI<1
QUIT
SET ORDER=$GET(^(VPRI))
Begin DoDot:1
+5 SET PI=$$WP^VPRSDA(+ORDER,"PI")
if PI=""
QUIT
+6 SET SIG=$$WP^VPRSDA(+ORDER,"SIG")
if SIG[PI
QUIT
+7 SET SIG=$$UP^XLFSTR(SIG)
SET PI=$$UP^XLFSTR(PI)
+8 SET PI=$$TRIM^XLFSTR(PI)
if SIG[PI
QUIT
+9 SET VPRN=VPRN+1
SET DLIST(VPRN)=+ORDER
End DoDot:1
if VPRN'<DMAX
QUIT
+10 KILL ^TMP("ORR",$JOB)
+11 QUIT
