source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29WO.m@ 1800

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