RMPR29W2 ;HOIFO/SPS - WORK ORDER MATERIAL GRID OWL PROGRAM ;11/8/05 07:12
;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
;
;
A1(RMPR6642) ;entry point for testing
D A2
Q
EN(RESULT,RMPR6642) ; -- Broker callback to get list to display
A2 N STRING,CLREND,COLUMN,ON,OFF
S DATE=2010101
;S SITE="ALL",START=00,STOP=99
K ^TMP($J)
N RMPRA,CDATE,X
S (CNT,VALMCNT)=0,RRX=""
I '$D(^RMPR(664.2,RMPR6642,0)) Q
D REC
G EXIT
Q
REC ;records to grid
;stop date, init action date
;check ien, patch 77
;
;
N DIC,DIQ,DR,STOPDT
;
;Get Work Order Data and add to array
S RMPRAON="" F S RMPRAON=$O(^RMPR(664.2,RMPR6642,1,RMPRAON)) Q:RMPRAON="" D
. Q:'$D(^RMPR(664.2,RMPR6642,1,RMPRAON,0))
. S CNT=CNT+1
. S RMPRII=^RMPR(664.2,RMPR6642,1,RMPRAON,0)
. ;Internal and external Material
. S RMPRMI=$P(RMPRII,U),RMPRSME=$$EXTERNAL^DILFD(664.22,.01,"",RMPRMI)
. ;Internal/external unit of issue
. S RMPRUI=$P(RMPRII,U,7),RMPRUIE=$$EXTERNAL^DILFD(664.22,6,"",RMPRUI)
. ;Internal/external Vendor
. S RMPRVI=$P(RMPRII,U,6),RMPRVE=$$EXTERNAL^DILFD(664.22,5,"",RMPRVI)
. ;Internal/external patient category
. ;S RMPRPCI=$P(RMPRII,U,8),RMPRPCE=$$EXTERNAL^DILFD(664.16,9,"",RMPRPCI)
. ;Internal/External HCPCS
. ;S RMPRPHCI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,1),RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI)
. ;Internal/External CPT Modifier
. ;S RMPRMI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,2)
. ;,RMPRPHCE=$$EXTERNAL^DILFD(81.3,"",RMPRME)
. S ^TMP($J,"RMPRM",CNT)=0_U_RMPRAON_U_RMPRSME_U_$P(RMPRII,U,2)_U_$P(RMPRII,U,3)_U_$P(RMPRII,U,4)_U_RMPRVE_U_RMPRUIE
. S ^TMP($J,"RMPRM",CNT)=^TMP($J,"RMPRM",CNT)_U_$P(RMPRII,U,8)_U_$P(RMPRII,U,11)_U_$P(RMPRII,U,12)
K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE
;PUT RESULTS IN GLOBAL!!
Q
K DNT,DATE,RMPRAON,RMPRII,RMPRMI,RMPRSME,RMPRUI,RMPRUIE,RMPRVE,RMPRVI,RRX,VALMCNT
EXIT ;common exit point
S RESULT=$NA(^TMP($J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29W2 1938 printed Dec 13, 2024@02:32:32 Page 2
RMPR29W2 ;HOIFO/SPS - WORK ORDER MATERIAL GRID OWL PROGRAM ;11/8/05 07:12
+1 ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
+2 ;
+3 ;
A1(RMPR6642) ;entry point for testing
+1 DO A2
+2 QUIT
EN(RESULT,RMPR6642) ; -- Broker callback to get list to display
A2 NEW STRING,CLREND,COLUMN,ON,OFF
+1 SET DATE=2010101
+2 ;S SITE="ALL",START=00,STOP=99
+3 KILL ^TMP($JOB)
+4 NEW RMPRA,CDATE,X
+5 SET (CNT,VALMCNT)=0
SET RRX=""
+6 IF '$DATA(^RMPR(664.2,RMPR6642,0))
QUIT
+7 DO REC
+8 GOTO EXIT
+9 QUIT
REC ;records to grid
+1 ;stop date, init action date
+2 ;check ien, patch 77
+3 ;
+4 ;
+5 NEW DIC,DIQ,DR,STOPDT
+6 ;
+7 ;Get Work Order Data and add to array
+8 SET RMPRAON=""
FOR
SET RMPRAON=$ORDER(^RMPR(664.2,RMPR6642,1,RMPRAON))
if RMPRAON=""
QUIT
Begin DoDot:1
+9 if '$DATA(^RMPR(664.2,RMPR6642,1,RMPRAON,0))
QUIT
+10 SET CNT=CNT+1
+11 SET RMPRII=^RMPR(664.2,RMPR6642,1,RMPRAON,0)
+12 ;Internal and external Material
+13 SET RMPRMI=$PIECE(RMPRII,U)
SET RMPRSME=$$EXTERNAL^DILFD(664.22,.01,"",RMPRMI)
+14 ;Internal/external unit of issue
+15 SET RMPRUI=$PIECE(RMPRII,U,7)
SET RMPRUIE=$$EXTERNAL^DILFD(664.22,6,"",RMPRUI)
+16 ;Internal/external Vendor
+17 SET RMPRVI=$PIECE(RMPRII,U,6)
SET RMPRVE=$$EXTERNAL^DILFD(664.22,5,"",RMPRVI)
+18 ;Internal/external patient category
+19 ;S RMPRPCI=$P(RMPRII,U,8),RMPRPCE=$$EXTERNAL^DILFD(664.16,9,"",RMPRPCI)
+20 ;Internal/External HCPCS
+21 ;S RMPRPHCI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,1),RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI)
+22 ;Internal/External CPT Modifier
+23 ;S RMPRMI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,2)
+24 ;,RMPRPHCE=$$EXTERNAL^DILFD(81.3,"",RMPRME)
+25 SET ^TMP($JOB,"RMPRM",CNT)=0_U_RMPRAON_U_RMPRSME_U_$PIECE(RMPRII,U,2)_U_$PIECE(RMPRII,U,3)_U_$PIECE(RMPRII,U,4)_U_RMPRVE_U_RMPRUIE
+26 SET ^TMP($JOB,"RMPRM",CNT)=^TMP($JOB,"RMPRM",CNT)_U_$PIECE(RMPRII,U,8)_U_$PIECE(RMPRII,U,11)_U_$PIECE(RMPRII,U,12)
End DoDot:1
+27 KILL CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE
+28 ;PUT RESULTS IN GLOBAL!!
+29 QUIT
+30 KILL DNT,DATE,RMPRAON,RMPRII,RMPRMI,RMPRSME,RMPRUI,RMPRUIE,RMPRVE,RMPRVI,RRX,VALMCNT
EXIT ;common exit point
+1 SET RESULT=$NAME(^TMP($JOB))
+2 QUIT
