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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29WO 3952 printed Apr 09, 2024@21:38:05 Page 2
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
+2 ;
+3 ;SORT - STATUS OF 664.1, if CA change to X to check.
+4 ;
A1(SORT) ;entry point for testing
+1 DO A2
+2 QUIT
EN(RESULT,SORT) ; -- Broker callback to get list to display
A2 NEW STRING,CLREND,COLUMN,ON,OFF
+1 SET DATE=2010101
+2 SET SITE="ALL"
SET START=00
SET STOP=99
+3 KILL ^TMP($JOB)
+4 NEW RMPRA,CDATE,X
+5 KILL ADATE,PDAY,RMPRCD
+6 SET (CNT,VALMCNT)=0
SET (RMPR6641,RRX)=""
+7 FOR
SET RMPR6641=$ORDER(^RMPR(664.1,RMPR6641))
if RMPR6641=""
QUIT
Begin DoDot:1
+8 IF '$DATA(^RMPR(664.1,RMPR6641,0))
QUIT
+9 IF $PIECE(^RMPR(664.1,RMPR6641,0),U,13)=""
QUIT
+10 SET WO66410=^RMPR(664.1,RMPR6641,0)
+11 SET RMSTS=$PIECE(WO66410,U,17)
+12 IF RMSTS="CA"
SET RMSTS="X"
+13 IF RMSTS="PC"
QUIT
+14 IF SORT'[RMSTS
QUIT
+15 IF RMSTS="X"
SET RMSTS="CA"
+16 SET RMSTS=$$EXTERNAL^DILFD(664.1,16,"",RMSTS)
+17 SET RMRDTI=$PIECE(WO66410,U,9)
+18 SET RMPRA=$PIECE(WO66410,U,8)
if RMPRA'>0
QUIT
Begin DoDot:2
+19 SET STN=$PIECE(^RMPR(668,RMPRA,0),U,7)
+20 SET STNX=$$STATN^RMPRUTIL(STN)
+21 ;ssn range filter
+22 SET DFN=$PIECE(^RMPR(668,RMPRA,0),U,2)
+23 DO DEM^VADPT
+24 SET SSNEN=$EXTRACT($PIECE(VADM(2),"^",2),10,11)
+25 IF SSNEN>STOP
QUIT
+26 IF SSNEN<START
QUIT
+27 KILL SSNEN,VADM
+28 DO REC
End DoDot:2
End DoDot:1
+29 SET I=""
+30 FOR
SET I=$ORDER(^TMP($JOB,I))
if I'>0
QUIT
Begin DoDot:1
+31 if '$DATA(^TMP($JOB,I))
QUIT
+32 SET ^TMP($JOB,"RMPRWO",CNT)=^TMP($JOB,I)
+33 SET CNT=CNT-1
End DoDot:1
+34 GOTO EXIT
+35 QUIT
REC ;records to grid
+1 ;stop date, init action date
+2 ;check ien, patch 77
+3 ;
+4 NEW DIC,DIQ,DR,STOPDT
+5 SET STOPDT=$PIECE($GET(^RMPR(668,RMPRA,0)),U,9)
SET STOPDT=$$DAT2^RMPRUTL1(STOPDT)
+6 IF $DATA(RMRDTI)
SET RMRDTE=$$DAT2^RMPRUTL1(RMRDTI)
+7 SET CDATE=$PIECE(^RMPR(668,RMPRA,0),U,1)
SET CDATE=$$DAT2^RMPRUTL1(CDATE)
+8 SET WDATE=$PIECE(^RMPR(664.1,RMPR6641,0),U,1)
SET WDATE=$$DAT2^RMPRUTL1(WDATE)
+9 SET RMWDTI=$PIECE(^RMPR(664.1,RMPR6641,0),U,1)
+10 SET DFN=$PIECE(^RMPR(668,RMPRA,0),U,2)
if DFN=""
QUIT
+11 NEW VA,VADM
+12 DO DEM^VADPT
+13 SET WHO=VADM(1)
+14 SET SSN=VADM(2)
+15 DO SVC^VADPT
+16 SET RMPROEOI=$SELECT(VASV(11)>0:"<!>",VASV(12)>0:"<!>",VASV(13)>0:"<!>",1:0)
+17 DO KVAR^VADPT
+18 ;type
+19 SET TYPE=$$TYPE^RMPREOU(RMPRA,8)
+20 if TYPE'["LAB"
QUIT
+21 SET CNT=CNT+1
+22 ;display description if manual
+23 SET DES=$$DES^RMPREOU(RMPRA,22)
+24 SET DES=$TRANSLATE(DES,"^","*")
+25 SET DES=$TRANSLATE(DES,"""","'")
+26 ;init action date
+27 SET ADATE=""
SET PDAY=""
SET WRKDAY=""
+28 SET ADATE=$PIECE(^RMPR(668,RMPRA,0),U,9)
+29 ;PPD=1 for previous pending
+30 IF ADATE'=""
SET CDAY=$$PDAY^RMPREOU(RMPRA)
+31 ;
+32 SET LINKED=$PIECE($GET(^RMPR(668,RMPRA,10,0)),U,4)
+33 IF LINKED=""
SET LINKED=0
+34 ;
+35 ; Note for list the Variable SSN is in the format NNNNNNNNN^NNN-NN-NNNN
+36 ; Thus making up 2 pieces of the data string below.
+37 IF RMPROEOI="<!>"
SET WHO=RMPROEOI_WHO
+38 SET ^TMP($JOB,RMPR6641)=CDATE_U_DFN_U_WHO_U_SSN_U_TYPE_U_DES
+39 SET ^TMP($JOB,RMPR6641)=^TMP($JOB,RMPR6641)_U_RMSTS_U_RMPRA_U_RMPR6641
+40 ;Get Work Order Data and add to array
+41 SET RMPRPHCI=$PIECE($GET(^RMPR(664.1,RMPR6641,2,1,0)),U,1)
SET RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI)
+42 SET RMPRWN=$PIECE(WO66410,U,13)
+43 SET RMPRROFF=$$EXTERNAL^DILFD(664.1,13,"",$PIECE(WO66410,U,5))
+44 SET RMPRTECH=$$EXTERNAL^DILFD(664.1,13,"",$PIECE(WO66410,U,16))
+45 SET RMPRSOPI=$PIECE(WO66410,U,11)
SET RMPRSOPE=$$EXTERNAL^DILFD(664.1,2,"",RMPRSOPI)
+46 SET RMNPPDSI=$PIECE(WO66410,U,3)
SET RMNPPDSE=$$EXTERNAL^DILFD(664.1,.03,"",RMNPPDSI)
SET RMNPPDSN=$$STATN^RMPRUTIL(RMNPPDSI)
+47 SET RMPRSITE=$ORDER(^RMPR(669.9,"C",RMNPPDSI,0))
+48 SET RMREQSTI=$PIECE(WO66410,U,4)
SET RMREQSTE=$$EXTERNAL^DILFD(664.1,.04,"",RMREQSTI)
SET RMREQSTN=$$STATN^RMPRUTIL(RMREQSTI)
+49 SET RMRECSTI=$PIECE(WO66410,U,15)
SET RMRECSTE=$$EXTERNAL^DILFD(664.1,.11,"",RMRECSTI)
SET RMRECSTN=$$STATN^RMPRUTIL(RMRECSTI)
+50 SET ^TMP($JOB,RMPR6641)=^TMP($JOB,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
+51 KILL CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE,RMRDTE
+52 ;PUT RESULTS IN GLOBAL!!
+53 QUIT
+54 KILL CDAY,CNT,DATE,DFN,I,LINKED,RMNPPDSE,RMNPPDSI,RMNPPDSN,RMPR6641
+55 KILL RMPRPHCE,RMPRPHCI,RMPRROFF,RMPRSITE,RMPRSOPE,RMPRSOPI,RMPRTECH
+56 KILL RMPRWN,RMPRDTI,RMRECSTE,RMRECSTI,RMRECSTN,RMREQSTE,RMREQSTI
+57 KILL RMREQSTN,RMSTS,RMWDTI,RRX,SITE,START,STN,STNX,STOP,VALMCNT,WDATE,WO66410,WRKDAY
EXIT ;common exit point
+1 SET RESULT=$NAME(^TMP($JOB,"RMPRWO"))
+2 QUIT
