Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPR29WO

RMPR29WO.m

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