Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPR144P

RMPR144P.m

Go to the documentation of this file.
  1. RMPR144P ;VMP/RB - FIX LAB REQUEST POINTER PROBLEM FOR FILE #660 ;12/20/07
  1. ;;3.0;Prosthetics;**144**;12/20/07;Build 17
  1. ;;
  1. Q
  1. FIX660 ;1. Post install to correct lab request pointer problems for Purchase
  1. ; Card order 660 entries with incorrect Lab Request "LB" pointers.
  1. ;
  1. BUILD K ^XTMP("RMPR144P") D NOW^%DTC S RMSTART=%
  1. S ^XTMP("RMPR144P","START COMPILE")=RMSTART
  1. S ^XTMP("RMPR144P","END COMPILE")="RUNNING"
  1. S ^XTMP("RMPR144P",0)=$$FMADD^XLFDT(RMSTART,90)_"^"_RMSTART
  1. 0 ;FIND REPETITIVE LAB REQUEST BOGUS LINKS
  1. S IEN=0,U="^"
  1. 1 S IEN=$O(^RMPR(660,IEN)) G EXIT:IEN=""!(IEN]"@")
  1. S R=$G(^RMPR(660,IEN,0)),R10=$G(^RMPR(660,IEN,10))
  1. I R=""!($P(R,U)<3050101) G 1
  1. S LB=$G(^RMPR(660,IEN,"LB")) G 1:LB=""
  1. S LRQ=$P(LB,U,10) G 1:LRQ=""
  1. 2 ;check invalid links
  1. K XX,IENA,IENB
  1. S XX=$O(^RMPR(668,"F",IEN,0))
  1. S IENA=$P(R,U,2),RQ=$G(^RMPR(664.1,LRQ,0)),IENB=$P(RQ,U,2)
  1. I IENA=IENB G 1
  1. S ^XTMP("RMPR144P",660,IEN,0)=$G(LRQ)_U_$G(XX)_U_IENA_U_IENB
  1. S ^XTMP("RMPR144P",660,IEN,1)=LB,^XTMP("RMPR144P",660,IEN,3)=$P(R,U,1,9),^XTMP("RMPR144P",660,IEN,4)=$P(RQ,U,1,9)
  1. ;W !!,IEN,?12,IENA,?22,IENB,?40,LRQ,?60,XX,!,$P(R,U,1,9),!,LB,!,$P(RQ,U,1,9)
  1. K ^RMPR(660,IEN,"LB")
  1. G 1
  1. EXIT ;
  1. D NOW^%DTC S RMEND=%
  1. S ^XTMP("RMPR144P","END COMPILE")=RMEND
  1. K RMEND,RMSTART,%,IEN,R,R10,LRQ,LB,XX,IENA,IENB
  1. Q