source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29W2.m@ 1688

Last change on this file since 1688 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1RMPR29W2 ;HOIFO/SPS - WORK ORDER MATERIAL GRID OWL PROGRAM ;11/8/05 07:12
2 ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
3 ;
4 ;
5A1(RMPR6642) ;entry point for testing
6 D A2
7 Q
8EN(RESULT,RMPR6642) ; -- Broker callback to get list to display
9A2 N STRING,CLREND,COLUMN,ON,OFF
10 S DATE=2010101
11 ;S SITE="ALL",START=00,STOP=99
12 K ^TMP($J)
13 N RMPRA,CDATE,X
14 S (CNT,VALMCNT)=0,RRX=""
15 I '$D(^RMPR(664.2,RMPR6642,0)) Q
16 D REC
17 G EXIT
18 Q
19REC ;records to grid
20 ;stop date, init action date
21 ;check ien, patch 77
22 ;
23 ;
24 N DIC,DIQ,DR,STOPDT
25 ;
26 ;Get Work Order Data and add to array
27 S RMPRAON="" F S RMPRAON=$O(^RMPR(664.2,RMPR6642,1,RMPRAON)) Q:RMPRAON="" D
28 . Q:'$D(^RMPR(664.2,RMPR6642,1,RMPRAON,0))
29 . S CNT=CNT+1
30 . S RMPRII=^RMPR(664.2,RMPR6642,1,RMPRAON,0)
31 . ;Internal and external Material
32 . S RMPRMI=$P(RMPRII,U),RMPRSME=$$EXTERNAL^DILFD(664.22,.01,"",RMPRMI)
33 . ;Internal/external unit of issue
34 . S RMPRUI=$P(RMPRII,U,7),RMPRUIE=$$EXTERNAL^DILFD(664.22,6,"",RMPRUI)
35 . ;Internal/external Vendor
36 . S RMPRVI=$P(RMPRII,U,6),RMPRVE=$$EXTERNAL^DILFD(664.22,5,"",RMPRVI)
37 . ;Internal/external patient category
38 . ;S RMPRPCI=$P(RMPRII,U,8),RMPRPCE=$$EXTERNAL^DILFD(664.16,9,"",RMPRPCI)
39 . ;Internal/External HCPCS
40 . ;S RMPRPHCI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,1),RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI)
41 . ;Internal/External CPT Modifier
42 . ;S RMPRMI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,2)
43 . ;,RMPRPHCE=$$EXTERNAL^DILFD(81.3,"",RMPRME)
44 . 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
45 . S ^TMP($J,"RMPRM",CNT)=^TMP($J,"RMPRM",CNT)_U_$P(RMPRII,U,8)_U_$P(RMPRII,U,11)_U_$P(RMPRII,U,12)
46 K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE
47 ;PUT RESULTS IN GLOBAL!!
48 Q
49 K DNT,DATE,RMPRAON,RMPRII,RMPRMI,RMPRSME,RMPRUI,RMPRUIE,RMPRVE,RMPRVI,RRX,VALMCNT
50EXIT ;common exit point
51 S RESULT=$NA(^TMP($J))
52 Q
Note: See TracBrowser for help on using the repository browser.