VPRP24.m

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 ---VPRP24   988     printed  Apr 09, 2024@21:47:11                                                                                                                                                                                                       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