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