source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29W1.m@ 1424

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1RMPR29W1 ;HOIFO/SPS - WORK ORDER ADD ON GRID OWL PROGRAM ;11/8/05 07:12
2 ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
3 ;
4 ;
5A1(RMPR6641) ;entry point for testing
6 D A2
7 Q
8EN(RESULT,RMPR6641) ; -- Broker callback to get list to display
9A2 N STRING,CLREND,COLUMN,ON,OFF
10 S DATE=2010101
11 K ^TMP($J)
12 N RMPRA,CDATE,X
13 K ADATE,PDAY,RMPRCD
14 S (CNT,VALMCNT)=0,RRX=""
15 ;S (PPDAY,PPD,PPD1,PPD2,PPD3,PPD4,PPD5)=0
16 ;S (PPDDAY,PPDD1,PPDD2,PPDD3,PPDD4,PPDD5)=0
17 I '$D(^RMPR(664.1,RMPR6641,0)) Q
18 I $P(^RMPR(664.1,RMPR6641,0),U,13)="" Q
19 S WO66410=^RMPR(664.1,RMPR6641,0)
20 ;W !!,RMPR6641," ",WO66410
21 S RMPRA=$P(WO66410,U,8) Q:RMPRA'>0 D
22 .S STN=$P(^RMPR(668,RMPRA,0),U,7)
23 .S STNX=$$STATN^RMPRUTIL(STN)
24 .S STS=$P(^RMPR(668,RMPRA,0),U,10)
25 .;Q:STS'["P"
26 .S DFN=$P(^RMPR(668,RMPRA,0),U,2)
27 .D DEM^VADPT
28 .S SSNEN=$E($P(VADM(2),"^",2),10,11)
29 .K SSNEN,VADM
30 .D REC
31 G EXIT
32 Q
33 K CDAY,DNT,DATE,DFN,LINKED,PPD,PPDAY,RMPRAON,RMPRHCSN,RMPRII,RMPRMI
34 K RMPRPCE,RMPRPCI,RMPRPHCE,RMPRPHCI,RMPRTC,RMPRTTE,RMPRTTI,RMPRUI
35 K RMPRUIE,RRX,STN,STNX,STS,VALMCNT,WO66410,WRKDAY
36REC ;records to grid
37 ;stop date, init action date
38 ;check ien, patch 77
39 ;
40 ;Q:$D(^TMP($J,RMPRA))
41 ;
42 N DIC,DIQ,DR,STOPDT
43 ;S DA=RMPRA
44 ;S DIC=668,DIQ="RE",DR=10,DIQ(0)="EN" D EN^DIQ1
45 S STOPDT=$P($G(^RMPR(668,RMPRA,0)),U,9),STOPDT=$$DAT2^RMPRUTL1(STOPDT)
46 S CDATE=$P(^RMPR(668,RMPRA,0),U,1),CDATE=$$DAT2^RMPRUTL1(CDATE)
47 S DFN=$P(^RMPR(668,RMPRA,0),U,2) Q:DFN=""
48 N VA,VADM
49 D DEM^VADPT
50 S WHO=VADM(1)
51 S SSN=VADM(2)
52 D KVAR^VADPT
53 ;type
54 S TYPE=$$TYPE^RMPREOU(RMPRA,8)
55 Q:TYPE'["LAB"
56 ;W !,"AFTER",RMPRA," ",WO66410
57 ;display description if manual
58 S DES=$$DES^RMPREOU(RMPRA,22)
59 S DES=$TR(DES,"^","*")
60 S DES=$TR(DES,"""","'")
61 ;init action date
62 S ADATE="",PDAY="",WRKDAY=""
63 S ADATE=$P(^RMPR(668,RMPRA,0),U,9)
64 ;PPD=1 for previous pending
65 I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA)
66 ;
67 S STATUS=$$STATUS^RMPREOU(RMPRA)
68 I STATUS["PENDING" D
69 .I ADATE'=""&(ADATE<DATE) S PPD=1
70 .S PPDAY=$$PWRKDAY^RMPREOU(RMPRA)
71 S LINKED=$P($G(^RMPR(668,RMPRA,10,0)),U,4)
72 I LINKED="" S LINKED=0
73 ;
74 ;Get Work Order Data and add to array
75 S RMPRAON="" F S RMPRAON=$O(^RMPR(664.1,RMPR6641,2,RMPRAON)) Q:RMPRAON="" D
76 . Q:'$D(^RMPR(664.1,RMPR6641,2,RMPRAON,0))
77 . ;Change to send only item 1
78 . ;Q:RMPRAON>1
79 . S CNT=CNT+1
80 . S RMPRII=^RMPR(664.1,RMPR6641,2,RMPRAON,0)
81 . ;S RMPR6642=$P(RMPRII,U,6)
82 . ;Internal and external item
83 . ;S RMPRSOI=$P(RMPRII,U),RMPRSOIE=$$EXTERNAL^DILFD(664.16,.01,"",RMPRSOI)
84 . ;Chose to display 661.1 short description instead. left for PFU.
85 . ;Internal/external unit of issue
86 . S RMPRUI=$P(RMPRII,U,3),RMPRUIE=$$EXTERNAL^DILFD(664.16,3,"",RMPRUI)
87 . ;Internal/external Type of Transaction
88 . S RMPRTTI=$P(RMPRII,U,7),RMPRTTE=$$EXTERNAL^DILFD(664.16,8,"",RMPRTTI)
89 . ;Internal/external patient category
90 . S RMPRPCI=$P(RMPRII,U,8),RMPRPCE=$$EXTERNAL^DILFD(664.16,9,"",RMPRPCI)
91 . ;Internal/External HCPCS
92 . S RMPRPHCI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,1),RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI)
93 . ;HCPCS SHORT NAME
94 . I +RMPRPHCI>0 S RMPRHCSN=$P($G(^RMPR(661.1,RMPRPHCI,0)),U,2)
95 . E S RMPRHCSN="UNKNOWN HCPCS NAME"
96 . ;Internal/External CPT Modifier
97 . S RMPRMI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,2)
98 . S RMPRTC=$P(RMPRII,U,11)
99 . S ^TMP($J,RMPRA,CNT)=0_U_RMPRAON_U_RMPRHCSN_U_$P(RMPRII,U,2)_U_RMPRUIE_U_$P(RMPRII,U,4)_U_$P(RMPRII,U,5)
100 . S ^TMP($J,RMPRA,CNT)=^TMP($J,RMPRA,CNT)_U_$P(RMPRII,U,6)_U_RMPRTTE_U_RMPRPCE
101 . S ^TMP($J,RMPRA,CNT)=^TMP($J,RMPRA,CNT)_U_RMPRPHCE_U_RMPRMI_U_RMPRTC
102 K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE
103 ;PUT RESULTS IN GLOBAL!!
104 Q
105EXIT ;common exit point
106 S RESULT=$NA(^TMP($J))
107 Q
Note: See TracBrowser for help on using the repository browser.