source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29WO.m@ 868

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1RMPR29WO ;HOIFO/SPS - WORK ORDER GRID OWL PROGRAM ;11/8/05 07:12
2 ;;3.0;PROSTHETICS;**75,122,60**;Feb 09, 1996;Build 18
3 ;
4 ;SORT - STATUS OF 664.1, if CA change to X to check.
5 ;
6A1(SORT) ;entry point for testing
7 D A2
8 Q
9EN(RESULT,SORT) ; -- Broker callback to get list to display
10A2 N STRING,CLREND,COLUMN,ON,OFF
11 S DATE=2010101
12 S SITE="ALL",START=00,STOP=99
13 K ^TMP($J)
14 N RMPRA,CDATE,X
15 K ADATE,PDAY,RMPRCD
16 S (CNT,VALMCNT)=0,(RMPR6641,RRX)=""
17 F S RMPR6641=$O(^RMPR(664.1,RMPR6641)) Q:RMPR6641="" D
18 .I '$D(^RMPR(664.1,RMPR6641,0)) Q
19 .I $P(^RMPR(664.1,RMPR6641,0),U,13)="" Q
20 .S WO66410=^RMPR(664.1,RMPR6641,0)
21 .S RMSTS=$P(WO66410,U,17)
22 .I RMSTS="CA" S RMSTS="X"
23 .I RMSTS="PC" Q
24 .I SORT'[RMSTS Q
25 .I RMSTS="X" S RMSTS="CA"
26 .S RMSTS=$$EXTERNAL^DILFD(664.1,16,"",RMSTS)
27 .S RMRDTI=$P(WO66410,U,9)
28 .S RMPRA=$P(WO66410,U,8) Q:RMPRA'>0 D
29 ..S STN=$P(^RMPR(668,RMPRA,0),U,7)
30 ..S STNX=$$STATN^RMPRUTIL(STN)
31 ..;ssn range filter
32 ..S DFN=$P(^RMPR(668,RMPRA,0),U,2)
33 ..D DEM^VADPT
34 ..S SSNEN=$E($P(VADM(2),"^",2),10,11)
35 ..I SSNEN>STOP Q
36 ..I SSNEN<START Q
37 ..K SSNEN,VADM
38 ..D REC
39 S I=""
40 F S I=$O(^TMP($J,I)) Q:I'>0 D
41 .Q:'$D(^TMP($J,I))
42 .S ^TMP($J,"RMPRWO",CNT)=^TMP($J,I)
43 .S CNT=CNT-1
44 G EXIT
45 Q
46REC ;records to grid
47 ;stop date, init action date
48 ;check ien, patch 77
49 ;
50 N DIC,DIQ,DR,STOPDT
51 S STOPDT=$P($G(^RMPR(668,RMPRA,0)),U,9),STOPDT=$$DAT2^RMPRUTL1(STOPDT)
52 I $D(RMRDTI) S RMRDTE=$$DAT2^RMPRUTL1(RMRDTI)
53 S CDATE=$P(^RMPR(668,RMPRA,0),U,1),CDATE=$$DAT2^RMPRUTL1(CDATE)
54 S WDATE=$P(^RMPR(664.1,RMPR6641,0),U,1),WDATE=$$DAT2^RMPRUTL1(WDATE)
55 S RMWDTI=$P(^RMPR(664.1,RMPR6641,0),U,1)
56 S DFN=$P(^RMPR(668,RMPRA,0),U,2) Q:DFN=""
57 N VA,VADM
58 D DEM^VADPT
59 S WHO=VADM(1)
60 S SSN=VADM(2)
61 D SVC^VADPT
62 S RMPROEOI=$S(VASV(11)>0:"<!>",VASV(12)>0:"<!>",VASV(13)>0:"<!>",1:0)
63 D KVAR^VADPT
64 ;type
65 S TYPE=$$TYPE^RMPREOU(RMPRA,8)
66 Q:TYPE'["LAB"
67 S CNT=CNT+1
68 ;display description if manual
69 S DES=$$DES^RMPREOU(RMPRA,22)
70 S DES=$TR(DES,"^","*")
71 S DES=$TR(DES,"""","'")
72 ;init action date
73 S ADATE="",PDAY="",WRKDAY=""
74 S ADATE=$P(^RMPR(668,RMPRA,0),U,9)
75 ;PPD=1 for previous pending
76 I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA)
77 ;
78 S LINKED=$P($G(^RMPR(668,RMPRA,10,0)),U,4)
79 I LINKED="" S LINKED=0
80 ;
81 ; Note for list the Variable SSN is in the format NNNNNNNNN^NNN-NN-NNNN
82 ; Thus making up 2 pieces of the data string below.
83 I RMPROEOI="<!>" S WHO=RMPROEOI_WHO
84 S ^TMP($J,RMPR6641)=CDATE_U_DFN_U_WHO_U_SSN_U_TYPE_U_DES
85 S ^TMP($J,RMPR6641)=^TMP($J,RMPR6641)_U_RMSTS_U_RMPRA_U_RMPR6641
86 ;Get Work Order Data and add to array
87 S RMPRPHCI=$P($G(^RMPR(664.1,RMPR6641,2,1,0)),U,1),RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI)
88 S RMPRWN=$P(WO66410,U,13)
89 S RMPRROFF=$$EXTERNAL^DILFD(664.1,13,"",$P(WO66410,U,5))
90 S RMPRTECH=$$EXTERNAL^DILFD(664.1,13,"",$P(WO66410,U,16))
91 S RMPRSOPI=$P(WO66410,U,11),RMPRSOPE=$$EXTERNAL^DILFD(664.1,2,"",RMPRSOPI)
92 S RMNPPDSI=$P(WO66410,U,3),RMNPPDSE=$$EXTERNAL^DILFD(664.1,.03,"",RMNPPDSI),RMNPPDSN=$$STATN^RMPRUTIL(RMNPPDSI)
93 S RMPRSITE=$O(^RMPR(669.9,"C",RMNPPDSI,0))
94 S RMREQSTI=$P(WO66410,U,4),RMREQSTE=$$EXTERNAL^DILFD(664.1,.04,"",RMREQSTI),RMREQSTN=$$STATN^RMPRUTIL(RMREQSTI)
95 S RMRECSTI=$P(WO66410,U,15),RMRECSTE=$$EXTERNAL^DILFD(664.1,.11,"",RMRECSTI),RMRECSTN=$$STATN^RMPRUTIL(RMRECSTI)
96 S ^TMP($J,RMPR6641)=^TMP($J,RMPR6641)_U_RMPRPHCE_U_RMPRWN_U_RMPRROFF_U_RMPRTECH_U_RMPRSOPE_U_RMNPPDSN_U_RMNPPDSE_U_RMREQSTN_U_RMREQSTE_U_RMRECSTN_U_RMRECSTE_U_RMPRSITE_U_WDATE_U_RMRDTE
97 K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE,RMRDTE
98 ;PUT RESULTS IN GLOBAL!!
99 Q
100 K CDAY,CNT,DATE,DFN,I,LINKED,RMNPPDSE,RMNPPDSI,RMNPPDSN,RMPR6641
101 K RMPRPHCE,RMPRPHCI,RMPRROFF,RMPRSITE,RMPRSOPE,RMPRSOPI,RMPRTECH
102 K RMPRWN,RMPRDTI,RMRECSTE,RMRECSTI,RMRECSTN,RMREQSTE,RMREQSTI
103 K RMREQSTN,RMSTS,RMWDTI,RRX,SITE,START,STN,STNX,STOP,VALMCNT,WDATE,WO66410,WRKDAY
104EXIT ;common exit point
105 S RESULT=$NA(^TMP($J,"RMPRWO"))
106 Q
Note: See TracBrowser for help on using the repository browser.