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

RMPR29WO ;HOIFO/SPS -  WORK ORDER GRID OWL PROGRAM ;11/8/05  07:12
 ;;3.0;PROSTHETICS;**75,122,60**;Feb 09, 1996;Build 18
 ;
 ;SORT - STATUS OF 664.1, if CA change to X to check.
 ;
A1(SORT) ;entry point for testing
 D A2
 Q
EN(RESULT,SORT) ; -- 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
 K ADATE,PDAY,RMPRCD
 S (CNT,VALMCNT)=0,(RMPR6641,RRX)=""
 F  S RMPR6641=$O(^RMPR(664.1,RMPR6641)) Q:RMPR6641=""  D
 .I '$D(^RMPR(664.1,RMPR6641,0)) Q
 .I $P(^RMPR(664.1,RMPR6641,0),U,13)="" Q
 .S WO66410=^RMPR(664.1,RMPR6641,0)
 .S RMSTS=$P(WO66410,U,17)
 .I RMSTS="CA" S RMSTS="X"
 .I RMSTS="PC" Q
 .I SORT'[RMSTS Q
 .I RMSTS="X" S RMSTS="CA"
 .S RMSTS=$$EXTERNAL^DILFD(664.1,16,"",RMSTS)
 .S RMRDTI=$P(WO66410,U,9)
 .S RMPRA=$P(WO66410,U,8) Q:RMPRA'>0  D
 ..S STN=$P(^RMPR(668,RMPRA,0),U,7)
 ..S STNX=$$STATN^RMPRUTIL(STN)
 ..;ssn range filter
 ..S DFN=$P(^RMPR(668,RMPRA,0),U,2)
 ..D DEM^VADPT
 ..S SSNEN=$E($P(VADM(2),"^",2),10,11)
 ..I SSNEN>STOP Q
 ..I SSNEN<START Q
 ..K SSNEN,VADM
 ..D REC
 S I=""
 F  S I=$O(^TMP($J,I)) Q:I'>0  D
 .Q:'$D(^TMP($J,I))
 .S ^TMP($J,"RMPRWO",CNT)=^TMP($J,I)
 .S CNT=CNT-1
 G EXIT
 Q
REC ;records to grid
 ;stop date, init action date
 ;check ien, patch 77
 ;
 N DIC,DIQ,DR,STOPDT
 S STOPDT=$P($G(^RMPR(668,RMPRA,0)),U,9),STOPDT=$$DAT2^RMPRUTL1(STOPDT)
 I $D(RMRDTI) S RMRDTE=$$DAT2^RMPRUTL1(RMRDTI)
 S CDATE=$P(^RMPR(668,RMPRA,0),U,1),CDATE=$$DAT2^RMPRUTL1(CDATE)
 S WDATE=$P(^RMPR(664.1,RMPR6641,0),U,1),WDATE=$$DAT2^RMPRUTL1(WDATE)
 S RMWDTI=$P(^RMPR(664.1,RMPR6641,0),U,1)
 S DFN=$P(^RMPR(668,RMPRA,0),U,2) Q:DFN=""
 N VA,VADM
 D DEM^VADPT
 S WHO=VADM(1)
 S SSN=VADM(2)
 D SVC^VADPT
 S RMPROEOI=$S(VASV(11)>0:"<!>",VASV(12)>0:"<!>",VASV(13)>0:"<!>",1:0)
 D KVAR^VADPT
 ;type
 S TYPE=$$TYPE^RMPREOU(RMPRA,8)
 Q:TYPE'["LAB"
 S CNT=CNT+1
 ;display description if manual
 S DES=$$DES^RMPREOU(RMPRA,22)
 S DES=$TR(DES,"^","*")
 S DES=$TR(DES,"""","'")
 ;init action date
 S ADATE="",PDAY="",WRKDAY=""
 S ADATE=$P(^RMPR(668,RMPRA,0),U,9)
 ;PPD=1 for previous pending
 I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA)
 ;
 S LINKED=$P($G(^RMPR(668,RMPRA,10,0)),U,4)
 I LINKED="" S LINKED=0
 ;
 ; Note for list the Variable SSN is in the format NNNNNNNNN^NNN-NN-NNNN
 ; Thus making up 2 pieces of the data string below.
 I RMPROEOI="<!>" S WHO=RMPROEOI_WHO
 S ^TMP($J,RMPR6641)=CDATE_U_DFN_U_WHO_U_SSN_U_TYPE_U_DES
 S ^TMP($J,RMPR6641)=^TMP($J,RMPR6641)_U_RMSTS_U_RMPRA_U_RMPR6641
 ;Get Work Order Data and add to array
 S RMPRPHCI=$P($G(^RMPR(664.1,RMPR6641,2,1,0)),U,1),RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI)
 S RMPRWN=$P(WO66410,U,13)
 S RMPRROFF=$$EXTERNAL^DILFD(664.1,13,"",$P(WO66410,U,5))
 S RMPRTECH=$$EXTERNAL^DILFD(664.1,13,"",$P(WO66410,U,16))
 S RMPRSOPI=$P(WO66410,U,11),RMPRSOPE=$$EXTERNAL^DILFD(664.1,2,"",RMPRSOPI)
 S RMNPPDSI=$P(WO66410,U,3),RMNPPDSE=$$EXTERNAL^DILFD(664.1,.03,"",RMNPPDSI),RMNPPDSN=$$STATN^RMPRUTIL(RMNPPDSI)
 S RMPRSITE=$O(^RMPR(669.9,"C",RMNPPDSI,0))
 S RMREQSTI=$P(WO66410,U,4),RMREQSTE=$$EXTERNAL^DILFD(664.1,.04,"",RMREQSTI),RMREQSTN=$$STATN^RMPRUTIL(RMREQSTI)
 S RMRECSTI=$P(WO66410,U,15),RMRECSTE=$$EXTERNAL^DILFD(664.1,.11,"",RMRECSTI),RMRECSTN=$$STATN^RMPRUTIL(RMRECSTI)
 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
 K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE,RMRDTE
 ;PUT RESULTS IN GLOBAL!!
 Q
 K CDAY,CNT,DATE,DFN,I,LINKED,RMNPPDSE,RMNPPDSI,RMNPPDSN,RMPR6641
 K RMPRPHCE,RMPRPHCI,RMPRROFF,RMPRSITE,RMPRSOPE,RMPRSOPI,RMPRTECH
 K RMPRWN,RMPRDTI,RMRECSTE,RMRECSTI,RMRECSTN,RMREQSTE,RMREQSTI
 K RMREQSTN,RMSTS,RMWDTI,RRX,SITE,START,STN,STNX,STOP,VALMCNT,WDATE,WO66410,WRKDAY
EXIT ;common exit point
 S RESULT=$NA(^TMP($J,"RMPRWO"))
 Q