- RMPRPIU4 ;HINCIO/ODJ - APIS ;3/8/01
- ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
- Q
- ; Count number of issues
- ;
- ; Item level
- ISNI(RMPRSTN,RMPRL,RMPRH,RMPRI,RMPRSDT,RMPREDT,RMPROUP) ;
- N RMPR6,X,X1,X2,RMPRD,RMPRS,RMPRIEN,RMPR6I
- S RMPROUP("QUANTITY")=0
- S RMPROUP("VALUE")=0
- I $G(RMPREDT)="" D NOW^%DTC S RMPREDT=X ;end date def=today
- I $G(RMPRSDT)="" D ;start date def=365 days ago
- . S X1=RMPREDT,X2=-365 D C^%DTC
- . S RMPRSDT=X
- . Q
- S RMPRD=RMPRSDT
- F S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPRSTN,3,RMPRH,RMPRI,RMPRD)) Q:RMPRD=""!($P(RMPRD,".",1)>RMPREDT) D
- . S RMPRS=""
- . F S RMPRS=$O(^RMPR(661.6,"ASTHIDS",RMPRSTN,3,RMPRH,RMPRI,RMPRD,RMPRS)) Q:RMPRS="" D
- .. S RMPRIEN=""
- .. F S RMPRIEN=$O(^RMPR(661.6,"ASTHIDS",RMPRSTN,3,RMPRH,RMPRI,RMPRD,RMPRS,RMPRIEN)) Q:RMPRIEN="" D
- ... K RMPR6
- ... S RMPR6("IEN")=RMPRIEN
- ... S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
- ... S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I)
- ... I RMPRL'=RMPR6I("LOCATION") Q
- ... S RMPROUP("QUANTITY")=RMPR6("QUANTITY")+RMPROUP("QUANTITY")
- ... S RMPROUP("VALUE")=RMPR6("VALUE")+RMPROUP("VALUE")
- ... Q
- .. Q
- . Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIU4 1135 printed Mar 13, 2025@21:41:09 Page 2
- RMPRPIU4 ;HINCIO/ODJ - APIS ;3/8/01
- +1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
- +2 QUIT
- +3 ; Count number of issues
- +4 ;
- +5 ; Item level
- ISNI(RMPRSTN,RMPRL,RMPRH,RMPRI,RMPRSDT,RMPREDT,RMPROUP) ;
- +1 NEW RMPR6,X,X1,X2,RMPRD,RMPRS,RMPRIEN,RMPR6I
- +2 SET RMPROUP("QUANTITY")=0
- +3 SET RMPROUP("VALUE")=0
- +4 ;end date def=today
- IF $GET(RMPREDT)=""
- DO NOW^%DTC
- SET RMPREDT=X
- +5 ;start date def=365 days ago
- IF $GET(RMPRSDT)=""
- Begin DoDot:1
- +6 SET X1=RMPREDT
- SET X2=-365
- DO C^%DTC
- +7 SET RMPRSDT=X
- +8 QUIT
- End DoDot:1
- +9 SET RMPRD=RMPRSDT
- +10 FOR
- SET RMPRD=$ORDER(^RMPR(661.6,"ASTHIDS",RMPRSTN,3,RMPRH,RMPRI,RMPRD))
- if RMPRD=""!($PIECE(RMPRD,".",1)>RMPREDT)
- QUIT
- Begin DoDot:1
- +11 SET RMPRS=""
- +12 FOR
- SET RMPRS=$ORDER(^RMPR(661.6,"ASTHIDS",RMPRSTN,3,RMPRH,RMPRI,RMPRD,RMPRS))
- if RMPRS=""
- QUIT
- Begin DoDot:2
- +13 SET RMPRIEN=""
- +14 FOR
- SET RMPRIEN=$ORDER(^RMPR(661.6,"ASTHIDS",RMPRSTN,3,RMPRH,RMPRI,RMPRD,RMPRS,RMPRIEN))
- if RMPRIEN=""
- QUIT
- Begin DoDot:3
- +15 KILL RMPR6
- +16 SET RMPR6("IEN")=RMPRIEN
- +17 SET RMPRERR=$$GET^RMPRPIX6(.RMPR6)
- +18 SET RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I)
- +19 IF RMPRL'=RMPR6I("LOCATION")
- QUIT
- +20 SET RMPROUP("QUANTITY")=RMPR6("QUANTITY")+RMPROUP("QUANTITY")
- +21 SET RMPROUP("VALUE")=RMPR6("VALUE")+RMPROUP("VALUE")
- +22 QUIT
- End DoDot:3
- +23 QUIT
- End DoDot:2
- +24 QUIT
- End DoDot:1
- +25 QUIT
