RMPR9DO ;HOIFO/HNC - ORDER CONROL PROCESSING-REMOTE PROCEDURE ;9/8/03 07:12
;;3.0;PROSTHETICS;**59,77,90,60,135,163,188**;Feb 09, 1996;Build 1
;
;8/5/03 Make sure no dups, HNC patch 77
;
;Patch RMPR*3.0*163 check all three $O for x-ref 'L', 'L1' and 'CD' to
;insure the linked master record has a node 0 defined.
;
A1(START,STOP,SITE,SORT,DATE,WHAT) ;entry point for rollup
;activated from (option name)
I WHAT="S" D
.S STN1=0
.F S STN1=$O(^RMPR(669.9,STN1)) Q:STN1'>0 D
. .S SITE=STN1
. .D A2
I WHAT="ALL" G A2
Q
EN(RESULT,DUZ,START,STOP,SITE,SORT,DATE,RMPRPRSN) ; -- Broker callback to get list to display
;entry to send to PCM, WHAT=ALL or S for Summary Only
;RMPRPRSN=P for Purchasing D for Delayed Order Report
S (WHO,RMPRSC)=""
I RMPRPRSN="P" S RMPRSC=$O(^RMPR(669.9,"PA",DUZ,RMPRSC)) Q:(RMPRSC="")!(WHO'="") D
. I '$D(^RMPR(669.9,RMPRSC,0)) Q
. I '$D(^RMPR(669.9,RMPRSC,5,"B",DUZ)) Q
. S WHO=$O(^RMPR(669.9,RMPRSC,5,"B",DUZ,""))
. I START="" S START=$P(^RMPR(669.9,RMPRSC,5,WHO,0),U,2)
. I STOP="" S STOP=$P(^RMPR(669.9,RMPRSC,5,WHO,0),U,3)
A2 N STRING,CLREND,COLUMN,ON,OFF
Q:SORT=""
Q:DATE=""
Q:START=""
Q:STOP=""
Q:SITE=""
I SITE'="ALL" S SITE=$P(^RMPR(669.9,SITE,0),U,2)
K ^TMP($J)
N RMPRA,CDATE,X
K ADATE,PDAY,RMPRCD
S VALMCNT=0,RRX=""
;if sort for open or pending include all regardless of date
;if sort for cancelled or closed include from date passed forward
;
;PPD# status=pending before date, total days create to 1st action
;MHD# manual totals days create to 1st action
;CHD# consult totals days create to 1st action
;PPDD# status=pending before date, total days in pending state, 1st
; action to current date
;
S (LINE,MHD1,MHD2,MHD3,MHD4,MHD5,CHD1,CHD2,CHD3,CHD4,CHD5,CLNK,MLNK)=0
S (PPDAY,PPD,PPD1,PPD2,PPD3,PPD4,PPD5)=0
S (PPDDAY,PPDD1,PPDD2,PPDD3,PPDD4,PPDD5)=0
I SORT["O"!(SORT["P") D ALL
I SORT["C"!(SORT["X") D DTFWD
;S LINE=LINE+1
S ^TMP($J,"A1")="^^^^^^^^"_MHD1_U_MHD2_U_MHD3_U_MHD4_U_MHD5_"^^^^"_MLNK_U_0
I $G(WHAT)="S" S RMPRXM(1)=MHD1_U_MHD2_U_MHD3_U_MHD4_U_MHD5_U_MLNK_U_0
;S LINE=LINE+1
S ^TMP($J,"A2")="^^^^^^^^"_CHD1_U_CHD2_U_CHD3_U_CHD4_U_CHD5_"^^^^"_CLNK_U_1
I $G(WHAT)="S" S RMPRXM(2)=CHD1_U_CHD2_U_CHD3_U_CHD4_U_CHD5_U_CLNK_U_1
;S LINE=LINE+1
I $G(WHAT)="S" S RMPRXM(3)=PPD1_U_PPD2_U_PPD3_U_PPD4_U_PPD5_U_U_2
S ^TMP($J,"A3")="^^^^^^^^"_PPDD1_U_PPDD2_U_PPDD3_U_PPDD4_U_PPDD5_"^^^^^"_2
;S LINE=LINE+1
S ^TMP($J,"A4")="^^^^^^^^"_PPD1_U_PPD2_U_PPD3_U_PPD4_U_PPD5_"^^^^^"_3
;quarter rollup with full data
I $G(WHAT)="Q" D MAIL
;summary only
I $G(WHAT)="S" D MAILG
I $G(WHAT)="ALL" D MAILG,MAIL
I '$G(WHAT) G EXIT
Q
ALL ;all open pending records regardless of date passed
S RMPRI1=0
F RMPRI1=START:1:STOP D
.I $L(RMPRI1)=1 S RMPRI=0_RMPRI1
.E S RMPRI=RMPRI1
.S RMPRST=""
.F S RMPRST=$O(^RMPR(668,"L1",RMPRI,RMPRST)) Q:RMPRST="" D
. .Q:RMPRST="X"
. .Q:RMPRST="C"
. .I SORT'["P"&(RMPRST="P") Q
. .S RMPRA=0
. .F S RMPRA=$O(^RMPR(668,"L1",RMPRI,RMPRST,RMPRA)) Q:RMPRA'>0 D
. . .Q:'$D(^RMPR(668,RMPRA,0)) ;;Patch RMPR*3.0*163 check
. . .S STN=$P(^RMPR(668,RMPRA,0),U,7)
. . .I SITE'="ALL"&(SITE'=STN) Q
. . .S STNX=$$STATN^RMPRUTIL(STN)
. . .I $G(WHAT)="S" S VISNX=$P($G(^RMPR(669.9,STN1,"INV")),U,2)
. . .S STS=$P(^RMPR(668,RMPRA,0),U,10)
. . .Q:STS["X"
. . .Q:STS["C"
. . .I SORT'["O"&(STS="O") Q
. . .I SORT'["P"&(STS="P") Q
. . .D REC
Q
DTFWD ;from date passed forward
S RMPRI1=0
F RMPRI1=START:1:STOP D
.I $L(RMPRI1)=1 S RMPRI=0_RMPRI1
.E S RMPRI=RMPRI1
.S RMPRDTM=""
.F S RMPRDTM=$O(^RMPR(668,"L",RMPRI,RMPRDTM)) Q:RMPRDTM="" D
..Q:RMPRDTM=""
..Q:RMPRDTM<DATE
..S RMPRST=""
..F S RMPRST=$O(^RMPR(668,"L",RMPRI,RMPRDTM,RMPRST)) Q:RMPRST="" D
.. .Q:RMPRST="O"
.. .Q:RMPRST="P"
.. .I SORT'["X"&(RMPRST="X") Q
.. .I SORT'["C"&(RMPRST="C") Q
.. .S RMPRA=0
.. .F S RMPRA=$O(^RMPR(668,"L",RMPRI,RMPRDTM,RMPRST,RMPRA)) Q:RMPRA'>0 D
.. . .Q:'$D(^RMPR(668,RMPRA,0)) ;;;;Patch RMPR*3.0*163 check
.. . .Q:RMPRA=""
.. . .S STN=$P(^RMPR(668,RMPRA,0),U,7)
.. . .I SITE'="ALL"&(SITE'=STN) Q
.. . .S STNX=$$STATN^RMPRUTIL(STN)
.. . .I $G(WHAT)'="" S VISNX=$P($G(^RMPR(669.9,SITE,"INV")),U,2)
.. . .S STS=$P(^RMPR(668,RMPRA,0),U,10)
.. . .Q:STS["O"
.. . .Q:STS["P"
.. . .I SORT'["C"&(STS="C") Q
.. . .I SORT'["X"&(STS="X") Q
.. . .D REC
S RMPRDTC=$P(DATE,".",1)
F S RMPRDTC=$O(^RMPR(668,"CD",RMPRDTC)) Q:RMPRDTC="" D
.Q:RMPRDTC<DATE
.S RMPRDYS=0
.F S RMPRDYS=$O(^RMPR(668,"CD",RMPRDTC,RMPRDYS)) Q:RMPRDYS="" D
. .Q:RMPRDYS'>5
. .S RMPRA=0
. .F S RMPRA=$O(^RMPR(668,"CD",RMPRDTC,RMPRDYS,RMPRA)) Q:RMPRA'>0 D
. . .Q:'$D(^RMPR(668,RMPRA,0)) ;;Patch RMPR*3.0*163 check
. . .;check site
. . .S STN=$P(^RMPR(668,RMPRA,0),U,7)
. . .I SITE'="ALL"&(SITE'=STN) Q
. . .S STNX=$$STATN^RMPRUTIL(STN)
. . .;check status
. . .S STS=$P(^RMPR(668,RMPRA,0),U,10)
. . .I SORT'["O"&(STS="O") Q
. . .I SORT'["P"&(STS="P") Q
. . .I SORT'["C"&(STS="C") Q
. . .I SORT'["X"&(STS="X") Q
. . .;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
Q
REC ;records to grid
;stop date, init action date
;check ien, patch 77
;
Q:$D(^TMP($J,RMPRA))
;
N DIC,DIQ,DR,STOPDT
S DA=RMPRA
S DIC=668,DIQ="RE",DR=10,DIQ(0)="EN" D EN^DIQ1
S STOPDT=$P($G(^RMPR(668,RMPRA,0)),U,9),STOPDT=$$DAT2^RMPRUTL1(STOPDT)
S LINE=LINE+1
S CDATE=$P(^RMPR(668,RMPRA,0),U,1),CDATE=$$DAT2^RMPRUTL1(CDATE)
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)
;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 (PDAY,WRKDAY)=$$WRKDAY^RMPREOU(RMPRA)
I ADATE="" S (PDAY,WRKDAY)=$$CWRKDAY^RMPREOU(RMPRA) I $P(^RMPR(668,RMPRA,0),U,10)="X" S (PDAY,WRKDAY)=$$CANWKDY^RMPREOU(RMPRA)
I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA)
;
S STATUS=$$STATUS^RMPREOU(RMPRA)
I STATUS["PENDING" D
.I ADATE'=""&(ADATE<DATE) S PPD=1
.S PPDAY=$$PWRKDAY^RMPREOU(RMPRA)
S LINKED=$P($G(^RMPR(668,RMPRA,10,0)),U,4)
I LINKED="" S LINKED=0
;
I RMPROEOI="<!>" S WHO=RMPROEOI_WHO
S ^TMP($J,RMPRA)=CDATE_U_WHO_U_SSN_U_TYPE_U_DES_U
;look at pday and parse
S (HD1,HD2,HD3,HD4,HD5,DH6)=""
;SD Working Days in Pending Status
S (SD1,SD2,SD3,SD4,SD5)=0
I (PDAY>0)&(PDAY<6)!(PDAY=0) S HD1=PDAY,DH6="NO"
I (PPDAY>0)&(PPDAY<6)!(PPDAY=0) S SD1=PPDAY
I (PDAY>0)&(PDAY<6)&(TYPE["MANUAL")!(PDAY=0)&(TYPE["MANUAL") S MHD1=MHD1+1
I (PDAY>0)&(PDAY<6)&(TYPE'["MANUAL")!(PDAY=0)&(TYPE'["MANUAL") S CHD1=CHD1+1
I (PPDAY>0)&(PPDAY<6)&(STATUS["PENDING") S PPDD1=PPDD1+1
I (PDAY>0)&(PDAY<6)&(PPD=1) S PPD1=PPD1+1
I HD1="" S HD1=0
I (PDAY>5)&(PDAY<10) S HD2=PDAY,DH6="YES"
I (PPDAY>5)&(PPDAY<10) S SD2=PPDAY
I (PDAY>5)&(PDAY<10)&(TYPE["MANUAL") S MHD2=MHD2+1
I (PDAY>5)&(PDAY<10)&(TYPE'["MANUAL") S CHD2=CHD2+1
I (PPDAY>5)&(PPDAY<10)&(STATUS["PENDING") S PPDD2=PPDD2+1
I (PDAY>5)&(PDAY<10)&(PPD=1) S PPD2=PPD2+1
I HD2="" S HD2=0
I (PDAY>9)&(PDAY<30) S HD3=PDAY,DH6="YES"
I (PPDAY>9)&(PPDAY<30) S SD3=PPDAY
I (PDAY>9)&(PDAY<30)&(TYPE["MANUAL") S MHD3=MHD3+1
I (PDAY>9)&(PDAY<30)&(TYPE'["MANUAL") S CHD3=CHD3+1
I (PPDAY>9)&(PPDAY<30)&(STATUS["PENDING") S PPDD3=PPDD3+1
I (PDAY>9)&(PDAY<30)&(PPD=1) S PPD3=PPD3+1
I HD3="" S HD3=0
I (PDAY>29)&(PDAY<90) S HD4=PDAY,DH6="YES"
I (PPDAY>29)&(PPDAY<90) S SD4=PPDAY
I (PDAY>29)&(PDAY<90)&(TYPE["MANUAL") S MHD4=MHD4+1
I (PDAY>29)&(PDAY<90)&(TYPE'["MANUAL") S CHD4=CHD4+1
I (PPDAY>29)&(PPDAY<90)&(STATUS["PENDING") S PPDD4=PPDD4+1
I (PDAY>29)&(PDAY<90)&(PPD=1) S PPD4=PPD4+1
I HD4="" S HD4=0
I PDAY>89 S HD5=PDAY,DH6="YES"
I PPDAY>89 S SD5=PPDAY
I (PDAY>89)&(TYPE["MANUAL") S MHD5=MHD5+1
I (PDAY>89)&(TYPE'["MANUAL") S CHD5=CHD5+1
I (PPDAY>89)&(STATUS["PENDING") S PPDD5=PPDD5+1
I (PDAY>89)&(PPD=1) S PPD5=PPD5+1
I HD5="" S HD5=0
S (PPD,PPDAY)=0
I LINKED'=0&(TYPE["MANUAL") S MLNK=MLNK+1
I LINKED'=0&(TYPE'["MANUAL") S CLNK=CLNK+1
S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_STOPDT_U_DH6_U_HD1_U_HD2_U_HD3_U_HD4_U_HD5
S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_U_STATUS_U_RMPRA_U_STNX_U_LINKED
S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_U_U_SD1_U_SD2_U_SD3_U_SD4_U_SD5_U_DFN
K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE
;PUT RESULTS IN GLOBAL!!
Q
EXIT ;common exit point
S RESULT=$NA(^TMP($J))
Q
MAIL ;send to PCM full dataset
S XMY("G.RMPR SERVER")=""
S XMY("G.PROSTHETICS@PSAS.DOMAIN.EXT")=""
S XMDUZ=.5
S XMSUB="Full DOR From Station: "_STNX
N LASTIEN
S LASTIEN="A1",LASTIEN=$O(^TMP($J,LASTIEN),-1)
S ^TMP($J,LASTIEN+1)=^TMP($J,"A1")
S ^TMP($J,LASTIEN+2)=^TMP($J,"A2")
S ^TMP($J,LASTIEN+3)=^TMP($J,"A3")
S ^TMP($J,LASTIEN+4)=^TMP($J,"A4")
K ^TMP($J,"A1")
K ^TMP($J,"A2")
K ^TMP($J,"A3")
K ^TMP($J,"A4")
S XMTEXT="^TMP($J,"
D ^XMD
Q
MAILG ;Mail message to local staff
S XMDUZ=.5
S XMY("G.RMPR SERVER")=""
S XMY("VHACOPSASPIPReport@DOMAIN.EXT")=""
S XMSUB="DOR From Station: "_STNX
S RMPRMSG(1)="The Automated Delayed Order Report has transmitted to Prosthetics HQ."
S RMPRMSG(2)="This was activated by "_$P(XMFROM,"@",1)
S RMPRMSG(3)=""
S RMPRMSG(4)="Summary Data Transmitted, includes the following:"
S RMPRMSG(5)="Totals for site "_STNX_" listed in the order of 0-5, 6-9, 10-29, 30-89, 90+"
S RMPRMSG(6)="Seperated by ;"
S RMPRMSG(7)="***Number of MANUALS ;;"_STNX_";"_MHD1_";"_MHD2_";"_MHD3_";"_MHD4_";"_MHD5
S RMPRMSG(8)="***Number of CONSULTS ;;"_STNX_";"_CHD1_";"_CHD2_";"_CHD3_";"_CHD4_";"_CHD5
S RMPRMSG(9)="***Minus Previous Pending ;;"_STNX_";"_PPD1_";"_PPD2_";"_PPD3_";"_PPD4_";"_PPD5
S RMPRMSG(10)=""
S XMTEXT="RMPRMSG("
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR9DO 10126 printed Apr 09, 2024@21:38:23 Page 2
RMPR9DO ;HOIFO/HNC - ORDER CONROL PROCESSING-REMOTE PROCEDURE ;9/8/03 07:12
+1 ;;3.0;PROSTHETICS;**59,77,90,60,135,163,188**;Feb 09, 1996;Build 1
+2 ;
+3 ;8/5/03 Make sure no dups, HNC patch 77
+4 ;
+5 ;Patch RMPR*3.0*163 check all three $O for x-ref 'L', 'L1' and 'CD' to
+6 ;insure the linked master record has a node 0 defined.
+7 ;
A1(START,STOP,SITE,SORT,DATE,WHAT) ;entry point for rollup
+1 ;activated from (option name)
+2 IF WHAT="S"
Begin DoDot:1
+3 SET STN1=0
+4 FOR
SET STN1=$ORDER(^RMPR(669.9,STN1))
if STN1'>0
QUIT
Begin DoDot:2
+5 SET SITE=STN1
+6 DO A2
End DoDot:2
End DoDot:1
+7 IF WHAT="ALL"
GOTO A2
+8 QUIT
EN(RESULT,DUZ,START,STOP,SITE,SORT,DATE,RMPRPRSN) ; -- Broker callback to get list to display
+1 ;entry to send to PCM, WHAT=ALL or S for Summary Only
+2 ;RMPRPRSN=P for Purchasing D for Delayed Order Report
+3 SET (WHO,RMPRSC)=""
+4 IF RMPRPRSN="P"
SET RMPRSC=$ORDER(^RMPR(669.9,"PA",DUZ,RMPRSC))
if (RMPRSC="")!(WHO'="")
QUIT
Begin DoDot:1
+5 IF '$DATA(^RMPR(669.9,RMPRSC,0))
QUIT
+6 IF '$DATA(^RMPR(669.9,RMPRSC,5,"B",DUZ))
QUIT
+7 SET WHO=$ORDER(^RMPR(669.9,RMPRSC,5,"B",DUZ,""))
+8 IF START=""
SET START=$PIECE(^RMPR(669.9,RMPRSC,5,WHO,0),U,2)
+9 IF STOP=""
SET STOP=$PIECE(^RMPR(669.9,RMPRSC,5,WHO,0),U,3)
End DoDot:1
A2 NEW STRING,CLREND,COLUMN,ON,OFF
+1 if SORT=""
QUIT
+2 if DATE=""
QUIT
+3 if START=""
QUIT
+4 if STOP=""
QUIT
+5 if SITE=""
QUIT
+6 IF SITE'="ALL"
SET SITE=$PIECE(^RMPR(669.9,SITE,0),U,2)
+7 KILL ^TMP($JOB)
+8 NEW RMPRA,CDATE,X
+9 KILL ADATE,PDAY,RMPRCD
+10 SET VALMCNT=0
SET RRX=""
+11 ;if sort for open or pending include all regardless of date
+12 ;if sort for cancelled or closed include from date passed forward
+13 ;
+14 ;PPD# status=pending before date, total days create to 1st action
+15 ;MHD# manual totals days create to 1st action
+16 ;CHD# consult totals days create to 1st action
+17 ;PPDD# status=pending before date, total days in pending state, 1st
+18 ; action to current date
+19 ;
+20 SET (LINE,MHD1,MHD2,MHD3,MHD4,MHD5,CHD1,CHD2,CHD3,CHD4,CHD5,CLNK,MLNK)=0
+21 SET (PPDAY,PPD,PPD1,PPD2,PPD3,PPD4,PPD5)=0
+22 SET (PPDDAY,PPDD1,PPDD2,PPDD3,PPDD4,PPDD5)=0
+23 IF SORT["O"!(SORT["P")
DO ALL
+24 IF SORT["C"!(SORT["X")
DO DTFWD
+25 ;S LINE=LINE+1
+26 SET ^TMP($JOB,"A1")="^^^^^^^^"_MHD1_U_MHD2_U_MHD3_U_MHD4_U_MHD5_"^^^^"_MLNK_U_0
+27 IF $GET(WHAT)="S"
SET RMPRXM(1)=MHD1_U_MHD2_U_MHD3_U_MHD4_U_MHD5_U_MLNK_U_0
+28 ;S LINE=LINE+1
+29 SET ^TMP($JOB,"A2")="^^^^^^^^"_CHD1_U_CHD2_U_CHD3_U_CHD4_U_CHD5_"^^^^"_CLNK_U_1
+30 IF $GET(WHAT)="S"
SET RMPRXM(2)=CHD1_U_CHD2_U_CHD3_U_CHD4_U_CHD5_U_CLNK_U_1
+31 ;S LINE=LINE+1
+32 IF $GET(WHAT)="S"
SET RMPRXM(3)=PPD1_U_PPD2_U_PPD3_U_PPD4_U_PPD5_U_U_2
+33 SET ^TMP($JOB,"A3")="^^^^^^^^"_PPDD1_U_PPDD2_U_PPDD3_U_PPDD4_U_PPDD5_"^^^^^"_2
+34 ;S LINE=LINE+1
+35 SET ^TMP($JOB,"A4")="^^^^^^^^"_PPD1_U_PPD2_U_PPD3_U_PPD4_U_PPD5_"^^^^^"_3
+36 ;quarter rollup with full data
+37 IF $GET(WHAT)="Q"
DO MAIL
+38 ;summary only
+39 IF $GET(WHAT)="S"
DO MAILG
+40 IF $GET(WHAT)="ALL"
DO MAILG
DO MAIL
+41 IF '$GET(WHAT)
GOTO EXIT
+42 QUIT
ALL ;all open pending records regardless of date passed
+1 SET RMPRI1=0
+2 FOR RMPRI1=START:1:STOP
Begin DoDot:1
+3 IF $LENGTH(RMPRI1)=1
SET RMPRI=0_RMPRI1
+4 IF '$TEST
SET RMPRI=RMPRI1
+5 SET RMPRST=""
+6 FOR
SET RMPRST=$ORDER(^RMPR(668,"L1",RMPRI,RMPRST))
if RMPRST=""
QUIT
Begin DoDot:2
+7 if RMPRST="X"
QUIT
+8 if RMPRST="C"
QUIT
+9 IF SORT'["P"&(RMPRST="P")
QUIT
+10 SET RMPRA=0
+11 FOR
SET RMPRA=$ORDER(^RMPR(668,"L1",RMPRI,RMPRST,RMPRA))
if RMPRA'>0
QUIT
Begin DoDot:3
+12 ;;Patch RMPR*3.0*163 check
if '$DATA(^RMPR(668,RMPRA,0))
QUIT
+13 SET STN=$PIECE(^RMPR(668,RMPRA,0),U,7)
+14 IF SITE'="ALL"&(SITE'=STN)
QUIT
+15 SET STNX=$$STATN^RMPRUTIL(STN)
+16 IF $GET(WHAT)="S"
SET VISNX=$PIECE($GET(^RMPR(669.9,STN1,"INV")),U,2)
+17 SET STS=$PIECE(^RMPR(668,RMPRA,0),U,10)
+18 if STS["X"
QUIT
+19 if STS["C"
QUIT
+20 IF SORT'["O"&(STS="O")
QUIT
+21 IF SORT'["P"&(STS="P")
QUIT
+22 DO REC
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
DTFWD ;from date passed forward
+1 SET RMPRI1=0
+2 FOR RMPRI1=START:1:STOP
Begin DoDot:1
+3 IF $LENGTH(RMPRI1)=1
SET RMPRI=0_RMPRI1
+4 IF '$TEST
SET RMPRI=RMPRI1
+5 SET RMPRDTM=""
+6 FOR
SET RMPRDTM=$ORDER(^RMPR(668,"L",RMPRI,RMPRDTM))
if RMPRDTM=""
QUIT
Begin DoDot:2
+7 if RMPRDTM=""
QUIT
+8 if RMPRDTM<DATE
QUIT
+9 SET RMPRST=""
+10 FOR
SET RMPRST=$ORDER(^RMPR(668,"L",RMPRI,RMPRDTM,RMPRST))
if RMPRST=""
QUIT
Begin DoDot:3
+11 if RMPRST="O"
QUIT
+12 if RMPRST="P"
QUIT
+13 IF SORT'["X"&(RMPRST="X")
QUIT
+14 IF SORT'["C"&(RMPRST="C")
QUIT
+15 SET RMPRA=0
+16 FOR
SET RMPRA=$ORDER(^RMPR(668,"L",RMPRI,RMPRDTM,RMPRST,RMPRA))
if RMPRA'>0
QUIT
Begin DoDot:4
+17 ;;;;Patch RMPR*3.0*163 check
if '$DATA(^RMPR(668,RMPRA,0))
QUIT
+18 if RMPRA=""
QUIT
+19 SET STN=$PIECE(^RMPR(668,RMPRA,0),U,7)
+20 IF SITE'="ALL"&(SITE'=STN)
QUIT
+21 SET STNX=$$STATN^RMPRUTIL(STN)
+22 IF $GET(WHAT)'=""
SET VISNX=$PIECE($GET(^RMPR(669.9,SITE,"INV")),U,2)
+23 SET STS=$PIECE(^RMPR(668,RMPRA,0),U,10)
+24 if STS["O"
QUIT
+25 if STS["P"
QUIT
+26 IF SORT'["C"&(STS="C")
QUIT
+27 IF SORT'["X"&(STS="X")
QUIT
+28 DO REC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+29 SET RMPRDTC=$PIECE(DATE,".",1)
+30 FOR
SET RMPRDTC=$ORDER(^RMPR(668,"CD",RMPRDTC))
if RMPRDTC=""
QUIT
Begin DoDot:1
+31 if RMPRDTC<DATE
QUIT
+32 SET RMPRDYS=0
+33 FOR
SET RMPRDYS=$ORDER(^RMPR(668,"CD",RMPRDTC,RMPRDYS))
if RMPRDYS=""
QUIT
Begin DoDot:2
+34 if RMPRDYS'>5
QUIT
+35 SET RMPRA=0
+36 FOR
SET RMPRA=$ORDER(^RMPR(668,"CD",RMPRDTC,RMPRDYS,RMPRA))
if RMPRA'>0
QUIT
Begin DoDot:3
+37 ;;Patch RMPR*3.0*163 check
if '$DATA(^RMPR(668,RMPRA,0))
QUIT
+38 ;check site
+39 SET STN=$PIECE(^RMPR(668,RMPRA,0),U,7)
+40 IF SITE'="ALL"&(SITE'=STN)
QUIT
+41 SET STNX=$$STATN^RMPRUTIL(STN)
+42 ;check status
+43 SET STS=$PIECE(^RMPR(668,RMPRA,0),U,10)
+44 IF SORT'["O"&(STS="O")
QUIT
+45 IF SORT'["P"&(STS="P")
QUIT
+46 IF SORT'["C"&(STS="C")
QUIT
+47 IF SORT'["X"&(STS="X")
QUIT
+48 ;ssn range filter
+49 SET DFN=$PIECE(^RMPR(668,RMPRA,0),U,2)
+50 DO DEM^VADPT
+51 SET SSNEN=$EXTRACT($PIECE(VADM(2),"^",2),10,11)
+52 IF SSNEN>STOP
QUIT
+53 IF SSNEN<START
QUIT
+54 KILL SSNEN,VADM
+55 DO REC
End DoDot:3
End DoDot:2
End DoDot:1
+56 QUIT
REC ;records to grid
+1 ;stop date, init action date
+2 ;check ien, patch 77
+3 ;
+4 if $DATA(^TMP($JOB,RMPRA))
QUIT
+5 ;
+6 NEW DIC,DIQ,DR,STOPDT
+7 SET DA=RMPRA
+8 SET DIC=668
SET DIQ="RE"
SET DR=10
SET DIQ(0)="EN"
DO EN^DIQ1
+9 SET STOPDT=$PIECE($GET(^RMPR(668,RMPRA,0)),U,9)
SET STOPDT=$$DAT2^RMPRUTL1(STOPDT)
+10 SET LINE=LINE+1
+11 SET CDATE=$PIECE(^RMPR(668,RMPRA,0),U,1)
SET CDATE=$$DAT2^RMPRUTL1(CDATE)
+12 SET DFN=$PIECE(^RMPR(668,RMPRA,0),U,2)
if DFN=""
QUIT
+13 NEW VA,VADM
+14 DO DEM^VADPT
+15 SET WHO=VADM(1)
+16 SET SSN=VADM(2)
+17 DO SVC^VADPT
+18 SET RMPROEOI=$SELECT(VASV(11)>0:"<!>",VASV(12)>0:"<!>",VASV(13)>0:"<!>",1:0)
+19 DO KVAR^VADPT
+20 ;type
+21 SET TYPE=$$TYPE^RMPREOU(RMPRA,8)
+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 (PDAY,WRKDAY)=$$WRKDAY^RMPREOU(RMPRA)
+31 IF ADATE=""
SET (PDAY,WRKDAY)=$$CWRKDAY^RMPREOU(RMPRA)
IF $PIECE(^RMPR(668,RMPRA,0),U,10)="X"
SET (PDAY,WRKDAY)=$$CANWKDY^RMPREOU(RMPRA)
+32 IF ADATE'=""
SET CDAY=$$PDAY^RMPREOU(RMPRA)
+33 ;
+34 SET STATUS=$$STATUS^RMPREOU(RMPRA)
+35 IF STATUS["PENDING"
Begin DoDot:1
+36 IF ADATE'=""&(ADATE<DATE)
SET PPD=1
+37 SET PPDAY=$$PWRKDAY^RMPREOU(RMPRA)
End DoDot:1
+38 SET LINKED=$PIECE($GET(^RMPR(668,RMPRA,10,0)),U,4)
+39 IF LINKED=""
SET LINKED=0
+40 ;
+41 IF RMPROEOI="<!>"
SET WHO=RMPROEOI_WHO
+42 SET ^TMP($JOB,RMPRA)=CDATE_U_WHO_U_SSN_U_TYPE_U_DES_U
+43 ;look at pday and parse
+44 SET (HD1,HD2,HD3,HD4,HD5,DH6)=""
+45 ;SD Working Days in Pending Status
+46 SET (SD1,SD2,SD3,SD4,SD5)=0
+47 IF (PDAY>0)&(PDAY<6)!(PDAY=0)
SET HD1=PDAY
SET DH6="NO"
+48 IF (PPDAY>0)&(PPDAY<6)!(PPDAY=0)
SET SD1=PPDAY
+49 IF (PDAY>0)&(PDAY<6)&(TYPE["MANUAL")!(PDAY=0)&(TYPE["MANUAL")
SET MHD1=MHD1+1
+50 IF (PDAY>0)&(PDAY<6)&(TYPE'["MANUAL")!(PDAY=0)&(TYPE'["MANUAL")
SET CHD1=CHD1+1
+51 IF (PPDAY>0)&(PPDAY<6)&(STATUS["PENDING")
SET PPDD1=PPDD1+1
+52 IF (PDAY>0)&(PDAY<6)&(PPD=1)
SET PPD1=PPD1+1
+53 IF HD1=""
SET HD1=0
+54 IF (PDAY>5)&(PDAY<10)
SET HD2=PDAY
SET DH6="YES"
+55 IF (PPDAY>5)&(PPDAY<10)
SET SD2=PPDAY
+56 IF (PDAY>5)&(PDAY<10)&(TYPE["MANUAL")
SET MHD2=MHD2+1
+57 IF (PDAY>5)&(PDAY<10)&(TYPE'["MANUAL")
SET CHD2=CHD2+1
+58 IF (PPDAY>5)&(PPDAY<10)&(STATUS["PENDING")
SET PPDD2=PPDD2+1
+59 IF (PDAY>5)&(PDAY<10)&(PPD=1)
SET PPD2=PPD2+1
+60 IF HD2=""
SET HD2=0
+61 IF (PDAY>9)&(PDAY<30)
SET HD3=PDAY
SET DH6="YES"
+62 IF (PPDAY>9)&(PPDAY<30)
SET SD3=PPDAY
+63 IF (PDAY>9)&(PDAY<30)&(TYPE["MANUAL")
SET MHD3=MHD3+1
+64 IF (PDAY>9)&(PDAY<30)&(TYPE'["MANUAL")
SET CHD3=CHD3+1
+65 IF (PPDAY>9)&(PPDAY<30)&(STATUS["PENDING")
SET PPDD3=PPDD3+1
+66 IF (PDAY>9)&(PDAY<30)&(PPD=1)
SET PPD3=PPD3+1
+67 IF HD3=""
SET HD3=0
+68 IF (PDAY>29)&(PDAY<90)
SET HD4=PDAY
SET DH6="YES"
+69 IF (PPDAY>29)&(PPDAY<90)
SET SD4=PPDAY
+70 IF (PDAY>29)&(PDAY<90)&(TYPE["MANUAL")
SET MHD4=MHD4+1
+71 IF (PDAY>29)&(PDAY<90)&(TYPE'["MANUAL")
SET CHD4=CHD4+1
+72 IF (PPDAY>29)&(PPDAY<90)&(STATUS["PENDING")
SET PPDD4=PPDD4+1
+73 IF (PDAY>29)&(PDAY<90)&(PPD=1)
SET PPD4=PPD4+1
+74 IF HD4=""
SET HD4=0
+75 IF PDAY>89
SET HD5=PDAY
SET DH6="YES"
+76 IF PPDAY>89
SET SD5=PPDAY
+77 IF (PDAY>89)&(TYPE["MANUAL")
SET MHD5=MHD5+1
+78 IF (PDAY>89)&(TYPE'["MANUAL")
SET CHD5=CHD5+1
+79 IF (PPDAY>89)&(STATUS["PENDING")
SET PPDD5=PPDD5+1
+80 IF (PDAY>89)&(PPD=1)
SET PPD5=PPD5+1
+81 IF HD5=""
SET HD5=0
+82 SET (PPD,PPDAY)=0
+83 IF LINKED'=0&(TYPE["MANUAL")
SET MLNK=MLNK+1
+84 IF LINKED'=0&(TYPE'["MANUAL")
SET CLNK=CLNK+1
+85 SET ^TMP($JOB,RMPRA)=^TMP($JOB,RMPRA)_STOPDT_U_DH6_U_HD1_U_HD2_U_HD3_U_HD4_U_HD5
+86 SET ^TMP($JOB,RMPRA)=^TMP($JOB,RMPRA)_U_STATUS_U_RMPRA_U_STNX_U_LINKED
+87 SET ^TMP($JOB,RMPRA)=^TMP($JOB,RMPRA)_U_U_SD1_U_SD2_U_SD3_U_SD4_U_SD5_U_DFN
+88 KILL CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE
+89 ;PUT RESULTS IN GLOBAL!!
+90 QUIT
EXIT ;common exit point
+1 SET RESULT=$NAME(^TMP($JOB))
+2 QUIT
MAIL ;send to PCM full dataset
+1 SET XMY("G.RMPR SERVER")=""
+2 SET XMY("G.PROSTHETICS@PSAS.DOMAIN.EXT")=""
+3 SET XMDUZ=.5
+4 SET XMSUB="Full DOR From Station: "_STNX
+5 NEW LASTIEN
+6 SET LASTIEN="A1"
SET LASTIEN=$ORDER(^TMP($JOB,LASTIEN),-1)
+7 SET ^TMP($JOB,LASTIEN+1)=^TMP($JOB,"A1")
+8 SET ^TMP($JOB,LASTIEN+2)=^TMP($JOB,"A2")
+9 SET ^TMP($JOB,LASTIEN+3)=^TMP($JOB,"A3")
+10 SET ^TMP($JOB,LASTIEN+4)=^TMP($JOB,"A4")
+11 KILL ^TMP($JOB,"A1")
+12 KILL ^TMP($JOB,"A2")
+13 KILL ^TMP($JOB,"A3")
+14 KILL ^TMP($JOB,"A4")
+15 SET XMTEXT="^TMP($J,"
+16 DO ^XMD
+17 QUIT
MAILG ;Mail message to local staff
+1 SET XMDUZ=.5
+2 SET XMY("G.RMPR SERVER")=""
+3 SET XMY("VHACOPSASPIPReport@DOMAIN.EXT")=""
+4 SET XMSUB="DOR From Station: "_STNX
+5 SET RMPRMSG(1)="The Automated Delayed Order Report has transmitted to Prosthetics HQ."
+6 SET RMPRMSG(2)="This was activated by "_$PIECE(XMFROM,"@",1)
+7 SET RMPRMSG(3)=""
+8 SET RMPRMSG(4)="Summary Data Transmitted, includes the following:"
+9 SET RMPRMSG(5)="Totals for site "_STNX_" listed in the order of 0-5, 6-9, 10-29, 30-89, 90+"
+10 SET RMPRMSG(6)="Seperated by ;"
+11 SET RMPRMSG(7)="***Number of MANUALS ;;"_STNX_";"_MHD1_";"_MHD2_";"_MHD3_";"_MHD4_";"_MHD5
+12 SET RMPRMSG(8)="***Number of CONSULTS ;;"_STNX_";"_CHD1_";"_CHD2_";"_CHD3_";"_CHD4_";"_CHD5
+13 SET RMPRMSG(9)="***Minus Previous Pending ;;"_STNX_";"_PPD1_";"_PPD2_";"_PPD3_";"_PPD4_";"_PPD5
+14 SET RMPRMSG(10)=""
+15 SET XMTEXT="RMPRMSG("
+16 DO ^XMD
+17 QUIT
