215 lines
9.3 KiB
Mathematica
215 lines
9.3 KiB
Mathematica
RMPR5HQA ;HCIOFO/RVD - ITEM USAGE REPORT FOR HQ and CTL PRG ; 04 Oct 00
|
|
;;3.0;PROSTHETICS;**51**;Feb 09, 1996
|
|
;
|
|
;variables rmprdet,rmprpip1,rmprpip2 are external (from the server).
|
|
;all ITEMs for all STATION is the default processing for the date range.
|
|
START Q:RMPRPIP1>RMPRPIP2
|
|
D NATION^RMPR5HQ5 S RMPRSEL("*")="",RMPRSTN="*"
|
|
N RLN,RMPAGE,R5,REQ,RSL,RMTVAL,RMTCOML,RMTDLEL,RMTUSEL,RHCPC,RMTVAH
|
|
N RMTUSEG,RMTVAG,RMTCOMG,RMTQOHG,RMTVALG,RMGVAL,RGCNT,RLCNT,RSCNT,RFL
|
|
N RLINE,RGRP,RST,RI,RST,RJ,RK,RGRP,RDAT,RMBD,RMED,RPR,RMARRAY,RMTUSEH
|
|
N RMTQOHNL,RMTQOHUL,RMTISNL,RMTISUL,RMTVALNL,RMTVALUL,RMTAVELU
|
|
N RMTQOHNG,RMTQOHUG,RMTISNG,RMTISUG,RMTVALNG,RMTVALUG,RMTCOMH,RMTISUH
|
|
N RMTVALUH,RMTVALNH,RMTQOHUH,RMTQOHNH,RMTDLEH,RMTDLEG,RMTAVEG,RMGTOT
|
|
N RTAVEGA,RTAVEGC,RTDLEGA,RTDLEGC,RTUSEGA,RTUSEGC,RMGTIU,RMGTIN,RMTISNH
|
|
N RTAVELA,RTAVELC,RTDLELA,RTDLELC,RTUSELA,RTUSELC,RMTUSELU,RMTUSELN
|
|
N RTAVEHA,RTAVEHC,RTDLEHA,RTDLEHC,RTUSEHA,RTUSEHC,RMCALDAY,RMTAVELN
|
|
;
|
|
S (RMTVAL,RMTCOML,RMTDLEL,RMTUSEL,RMTAVEG,RMGTOT,RMTUSELU,RMGISNG)=0
|
|
S (RMTQOHNL,RMTQOHUL,RMTISNL,RMTISUL,RMTVALNL,RMTVALUL,RMTAVELU)=0
|
|
S (RMTQOHNG,RMTQOHUG,RMTISNG,RMTISUG,RMTVALNG,RMTVALUG,RMTISUH)=0
|
|
S (RMTUSEG,RMTVAG,RMTCOMG,RMGTOU,RMGTON,RMTVAH,RMTCOMH,RMTVALUH)=0
|
|
S (RMGVAL,RGCNT,RLCNT,RSCNT,RFL,RPRINT,RMTQOHNH,RMTUSEH,RMTDLEH)=0
|
|
S (RTAVEGA,RTAVEGC,RTDLEGA,RTDLEGC,RTUSEGA,RTUSEGC,RMGTIU,RMGTIN)=0
|
|
S (RTAVELA,RTAVELC,RTDLELA,RTDLELC,RTUSELA,RTUSELC,RMTAVELN)=0
|
|
S (RTAVEHA,RTAVEHC,RTDLEHA,RTDLEHC,RTUSEHA,RTUSEHC,RC,RPR)=0
|
|
S (RMTVALNH,RMTQOHUH,RMTISNH,RMTUSELN,RMGISUG)=0
|
|
S (RLINE,RGRP,RST,RNPGRP,RNPLINE,RHCPC,RMTDLEG,RSTA)=""
|
|
;
|
|
S X2=RMPRPIP1,X1=RMPRPIP2 D ^%DTC S RMCALDAY=X+1
|
|
S Y=RMPRPIP1 D DD^%DT S RMBD=Y S Y=RMPRPIP2 D DD^%DT S RMED=Y
|
|
D NOW^%DTC S Y=% X ^DD("DD") S RMRDATE=Y
|
|
S $P(RLN,"-",132)="",RMPAGE=0,R5="RMPR5",$P(REQ,"=",132)=""
|
|
S $P(RES,"*",132)="",$P(RB1," ",2)=""
|
|
S $P(RB2," ",3)=""
|
|
S $P(RB3," ",4)=""
|
|
S $P(RB4," ",5)=""
|
|
S $P(RB5," ",6)=""
|
|
S $P(RB6," ",7)=""
|
|
S $P(RB7," ",8)=""
|
|
S $P(RB8," ",9)=""
|
|
S $P(RB9," ",10)=""
|
|
S $P(RB10," ",11)=""
|
|
S $P(RB11," ",12)=""
|
|
S $P(RB12," ",13)=""
|
|
S $P(RB13," ",14)=""
|
|
S $P(RB14," ",15)=""
|
|
S $P(RB15," ",16)=""
|
|
S $P(RB16," ",17)=""
|
|
S $P(RB18," ",19)=""
|
|
S $P(RB23," ",24)=""
|
|
S $P(RB24," ",25)=""
|
|
S $P(RB26," ",27)=""
|
|
S $P(RB30," ",31)=""
|
|
S $P(RB31," ",32)=""
|
|
S $P(RB33," ",34)=""
|
|
S $P(RB50," ",51)=""
|
|
K RX D GRPARY^RMPR5HQ4(.RMARRAY)
|
|
;
|
|
ITEM ;entry point for Item Detail Usage report
|
|
I RMPRDET="I" S RMQSUBJ="PIP DETAIL ITEM REPORT" G DQ1
|
|
;
|
|
HCPCS ;entry point for HCPCS Summary Usage report.
|
|
I RMPRDET="H" S RMQSUBJ="PIP HCPCS SUMMARY REPORT" D ^RMPR5HQB G TOT
|
|
LINE ;entry point for NPPD LINE Usage report.
|
|
I RMPRDET="L" S RMQSUBJ="PIP NPPD LINE SUMMARY REPORT" D ^RMPR5HQC G TOT
|
|
;
|
|
GROUP ;entry point for NPPD GROUP Usage report.
|
|
I RMPRDET="G" S RMQSUBJ="PIP NPPD GROUP SUMMARY REPORT" D ^RMPR5HQD
|
|
G SEND
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
DQ1 ;print PIP Report (Item Detail Usage report).
|
|
;$O the ^TMP( global for all the records
|
|
;print all records based on the sort criteria given.
|
|
F RST=0:0 S RST=$O(^TMP($J,R5,RST)) Q:RST'>0 D:(RSTA'="")&(RSTA'=RST)&(RPR=1) HDRI S RSTA=RST F RI=0:0 S RI=$O(^TMP($J,R5,RST,RI)) Q:$G(RFL) Q:RI'>0 D
|
|
.D:RPR=0 HDRI S RNPGRP=RMARRAY(RI),RJ=""
|
|
.F S RJ=$O(^TMP($J,R5,RST,RI,RJ)) Q:$G(RFL) D:(RLINE'="")&(RLINE'=RJ) SUML1 Q:RJ="" D
|
|
..S RLINE=RJ,RNPLINE=$$NPLIN^RMPR5HQ5(RJ)
|
|
..I RGCNT=0 S RGCNT=RGCNT+1
|
|
..S RK="" F S RK=$O(^TMP($J,R5,RST,RI,RJ,RK)) Q:$G(RFL)!(RK="") D
|
|
...S RL="" F S RL=$O(^TMP($J,R5,RST,RI,RJ,RK,RL)) Q:$G(RFL)!(RL="") D
|
|
....S RHCPC=$P(RK,"/",1) S:RMPRDET="I" RHCPC=RHCPC_"-"_RL
|
|
....S RNPITEM=$$GETITEM^RMPR5HQ5($P(RK,"/",2),RL)
|
|
....I RLCNT=0 D GLN1
|
|
....S RLCNT=RLCNT+1,RDAT=^TMP($J,R5,RST,RI,RJ,RK,RL)
|
|
....S RMVA=$P(RDAT,U,1)
|
|
....S RMCOM=$P(RDAT,U,2)
|
|
....S RMUSE=$P(RDAT,U,3)
|
|
....S RMISU=$P(RDAT,U,4)
|
|
....S RMISN=$P(RDAT,U,5)
|
|
....S RMAVEN=$P(RDAT,U,6)
|
|
....S RMDLEN=$P(RDAT,U,7)
|
|
....S RMQOHU=$P(RDAT,U,8)
|
|
....S RMQOHN=$P(RDAT,U,9)
|
|
....S RMVALU=$P(RDAT,U,10)
|
|
....S RMVALN=$P(RDAT,U,11)
|
|
....S RMAVEU=$P(RDAT,U,12)
|
|
....S RMDLEU=$P(RDAT,U,13)
|
|
....S RMDLEU=$S(RMDLEU>999:">999",1:$J(RMDLEU,6,0))
|
|
....S RMDLEN=$S(RMDLEN>999:">999",1:$J(RMDLEN,6,0))
|
|
....S:(RMVA<1)&(RMVALU>0) RMDLEU=">"_RMCALDAY
|
|
....S:(RMCOM<1)&(RMVALN>0) RMDLEN=">"_RMCALDAY
|
|
....;total for line item
|
|
....S RMTVAL=RMTVAL+RMVA
|
|
....S RMTCOML=RMTCOML+RMCOM
|
|
....S:RMVA'="" RMTUSELU=RMTUSELU+RMVA
|
|
....S:RMCOM'="" RMTUSELN=RMTUSELN+RMCOM
|
|
....S RMTISUL=RMTISUL+RMISU
|
|
....S RMTISNL=RMTISNL+RMISN
|
|
....S RMTAVELU=RMTAVELU+RMAVEU
|
|
....S RMTAVELN=RMTAVELN+RMAVEN
|
|
....S RMTQOHUL=RMTQOHUL+RMQOHU
|
|
....S RMTQOHNL=RMTQOHNL+RMQOHN
|
|
....S RMTVALUL=RMTVALUL+RMVALU
|
|
....S RMTVALNL=RMTVALNL+RMVALN
|
|
....;total for group
|
|
....S RMTVAG=RMTVAG+RMVA
|
|
....S RMTCOMG=RMTCOMG+RMCOM
|
|
....S RMTUSEG=RMTUSEG+RMVA
|
|
....S RMTISUG=RMTISUG+RMISU
|
|
....S RMTISNG=RMTISNG+RMISN
|
|
....S RMTQOHUG=RMTQOHUG+RMQOHU
|
|
....S RMTQOHNG=RMTQOHNG+RMQOHN
|
|
....S RMTVALUG=RMTVALUG+RMVALU
|
|
....S RMTVALNG=RMTVALNG+RMVALN
|
|
....S RMGTOU=RMGTOU+RMVALU
|
|
....S RMGTON=RMGTON+RMVALN
|
|
....S RMGTIU=RMGTIU+RMISU
|
|
....S RMGTIN=RMGTIN+RMISN
|
|
....S:'RMISU RMISU=""
|
|
....S:'RMISN RMISN=""
|
|
....S RMVALU=$FN(RMVALU,",",2) S:'RMVALU RMVALU=""
|
|
....S RMVALN=$FN(RMVALN,",",2) S:'RMVALN RMVALN=""
|
|
....S RNPITEM=RNPITEM_" "
|
|
....S RHCPC=RHCPC_" "
|
|
....;for used item
|
|
....I (RMVA>0)!(RMVALU>0)!(RMVALU<0) D CNTRX S ^TMP($J,"RI",RC)=$E(RHCPC,1,11)_$E(RNPITEM,1,12)_RB1_$J(RMVA,5)_RB1_$J($FN(RMISU,",",2),9)_RB1_"|"_RB18_"|"_RB1_$J(RMVA,5)_RB1_"|"_RB1_$J(RMAVEU,8,2)_RB1_"|"_RB1_$J(RMQOHU,6)
|
|
....I (RMVA>0)!(RMVALU>0)!(RMVALU<0) S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB8_"|"_RB1_$J(RMDLEU,6)_RB1_"|"_RB1_$J(RMVALU,11)
|
|
....;for new item
|
|
....I (RMCOM>0)!(RMVALN>0)!(RMVALN<0) D CNTRX S ^TMP($J,"RI",RC)=$E(RHCPC,1,11)_$E(RNPITEM,1,13)_RB16_"|"_RB1_$J(RMCOM,6)_RB1_$J($FN(RMISN,",",2),9)_RB1_"|"_RB1_$J(RMCOM,5)_RB1_"|"_RB1_$J(RMAVEN,8,2)_RB1_"|"
|
|
....I (RMCOM>0)!(RMVALN>0)!(RMVALN<0) S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB6_$J(RMQOHN,8)_RB1_"|"_RB1_$J(RMDLEN,6)_RB1_"|"_RB11_$J(RMVALN,11)
|
|
....S (RPRINT,RPR)=1
|
|
;
|
|
TOT ;print total for Used and New items (all report type)
|
|
G:$G(RFL) CLEAN1
|
|
D CNTRX S ^TMP($J,"RI",RC)="" D CNTRX S ^TMP($J,"RI",RC)=RLN
|
|
D CNTRX S ^TMP($J,"RI",RC)=""
|
|
I '$G(RPRINT) D CNTRX S ^TMP($J,"RI",RC)="No Records to Print !!" G CLEAN1
|
|
D CNTRX
|
|
S ^TMP($J,"RI",RC)=" GRAND TOTAL $ VALUE ISSUED (Used) = $"_$J($FN(RMGTIU,",",2),10)
|
|
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_" GRAND TOTAL $ VALUE ON-HAND (Used) = $"_$J($FN(RMGTOU,",",2),12)
|
|
D CNTRX
|
|
S ^TMP($J,"RI",RC)=" GRAND TOTAL $ VALUE ISSUED (New) = $"_$J($FN(RMGTIN,",",2),10)
|
|
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_" GRAND TOTAL $ VALUE ON-HAND (New) = $"_$J($FN(RMGTON,",",2),12)
|
|
D CNTRX S ^TMP($J,"RI",RC)="<End of Report>"
|
|
;
|
|
SEND ;send report to HQ
|
|
S RMQMAIL=$$GETADDR^RMPR5HQ1()
|
|
D:RMQMAIL="" NOADDR^RMPR5HQ1() G:$D(RQUIT) CLEAN1
|
|
S RD=$O(^TMP($J,"RMPR5",0)) S RMBDT=RMPRPIP1,RMEDT=RMPRPIP2
|
|
S XMSUB=RMQSUBJ,XMCHAN=1,XMDUZ=.5,XMY(RMQMAIL)=""
|
|
;next line for testing
|
|
D GET^XMA2 I XMZ<1 G CLEAN1
|
|
S RMQMES=XMZ,XMTEXT="^TMP($J,""RI""," D ^XMD
|
|
;send a confirmation message to local user.
|
|
D SENDCONF^RMPR5HQ1(RMQSUBJ,RMBD,RMED)
|
|
;
|
|
CLEAN1 ; Clean and EXITS program.
|
|
I $D(ZTQUEUED) S ZTREQ="@" Q
|
|
D ^%ZISC N RMPR,RMPRSITE D KILL^XUSCLEAN K ^TMP($J) Q
|
|
;
|
|
HDRI ;print heading.
|
|
D CNTRX S ^TMP($J,"RI",RC)=""
|
|
I RPR=1 D CNTRX S ^TMP($J,"RI",RC)=RES
|
|
D CNTRX S ^TMP($J,"RI",RC)="",RPR=1,RMPAGE=RMPAGE+1 D CNTRX
|
|
S ^TMP($J,"RI",RC)="PROSTHETIC INVENTORY ITEM DETAIL REPORT"_RB10_"Run Date: "_RMRDATE
|
|
S RSTN=$$STN^RMPR5HQC(RSTA)
|
|
D CNTRX S ^TMP($J,"RI",RC)="STATION: "_$E(RSTN,1,30)_RB6_RMBD_" - "_RMED_" [ "_RMCALDAY_" calendar days ]"
|
|
Q
|
|
;
|
|
CNTRX ;INCREMENT MAIL LINE COUNTER
|
|
S RC=RC+1 Q
|
|
;
|
|
LBL1 ;print column header.
|
|
D CNTRX S ^TMP($J,"RI",RC)=RLN D CNTRX
|
|
I RMPRDET="I" S ^TMP($J,"RI",RC)="HCPCS PSAS/ITEM"
|
|
I RMPRDET="H" S ^TMP($J,"RI",RC)="HCPCS DESCRIPTION"
|
|
I RMPRDET="L" S ^TMP($J,"RI",RC)="NPPD LINE "
|
|
I RMPRDET="G" S ^TMP($J,"RI",RC)="NPPD GROUP "
|
|
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_" V.A.(Used) Total| COM. (New) Total| Total |Days Ave | Stock On-Hand| Days |Total $ Value On-Hand"
|
|
D CNTRX
|
|
S ^TMP($J,"RI",RC)=RB23_"Issue $ Value| Issue $ Value| Issue |Usage Rate| Used New | On-Hand| Used New"
|
|
I RMPRDET'="G" D CNTRX S ^TMP($J,"RI",RC)=RLN
|
|
Q
|
|
;
|
|
GLN1 ;print NPPD GROUP and LINE header.
|
|
D CNTRX S ^TMP($J,"RI",RC)=""
|
|
D CNTRX S ^TMP($J,"RI",RC)=RJ_" "_RNPLINE_" ["_RNPGRP_" ]"
|
|
D LBL1 Q
|
|
;
|
|
SUML1 ;print summary total for NPPD LINE
|
|
D CNTRX S ^TMP($J,"RI",RC)=REQ
|
|
;next two lines print used total
|
|
D CNTRX S:$G(RMTUSELU) RMTAVELU=RMTUSELU/RMCALDAY
|
|
S:$G(RMTUSELN) RMTAVELN=RMTUSELN/RMCALDAY
|
|
S ^TMP($J,"RI",RC)=" (Used)"_RB13_$J(RMTVAL,5)_RB1_$J($FN(RMTISUL,",",2),9)_RB1_"|"_RB18_"|"_RB1_$J(RMTUSELU,5)_RB1_"|"_RB1_$J(RMTAVELU,8,2)_RB1_"|"
|
|
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB1_$J(RMTQOHUL,6)_RB8_"|"_RB8_"|"_RB1_$J($FN(RMTVALUL,",",2),11)
|
|
;next two lines print new total
|
|
D CNTRX
|
|
S ^TMP($J,"RI",RC)=" (New)"_RB30_"|"_RB1_$J(RMTCOML,6)_RB1_$J($FN(RMTISNL,",",2),9)_RB1_"|"_RB1_$J(RMTUSELN,5)_RB1_"|"_RB1_$J(RMTAVELN,8,2)_RB1_"|"
|
|
S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB6_$J(RMTQOHNL,8)_RB1_"|"_RB8_"|"_RB11_$J($FN(RMTVALNL,",",2),11)
|
|
S (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSEL,RMTAVELU,RMTAVELN,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL,RLCNT,RMTUSELU,RMTUSELN)=0
|
|
S (RNPLINE,RLINE)=""
|
|
Q
|