| 1 | RMPRPIXJ ;HIN/RVD - INVENTORY UTILITY UPDATE BALANCE ;2/13/01
|
---|
| 2 | ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
|
---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | W !,"***Invalid Entry!!!!" Q
|
---|
| 5 | ;
|
---|
| 6 | SVAL(RX) ;STARTING total Value.
|
---|
| 7 | ;The Starting total Value is the Total Value of the previous entry
|
---|
| 8 | ;date specified. If no previous entry, the Total Value will
|
---|
| 9 | ;be set to ZERO.
|
---|
| 10 | ;
|
---|
| 11 | ;pass variable station, hcpcs, hcpcs item and date in RX local array.
|
---|
| 12 | ; RX("STA") = station
|
---|
| 13 | ; RX("HCP") = HCPCS
|
---|
| 14 | ; RX("ITE") = HCPCS item
|
---|
| 15 | ; RX("RDT") = date (starting date)
|
---|
| 16 | ; REBAL = return variable (Starting Total Value based on the date)
|
---|
| 17 | N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
|
---|
| 18 | S REBAL=0
|
---|
| 19 | S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT")
|
---|
| 20 | Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL
|
---|
| 21 | S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1)
|
---|
| 22 | I '$G(RDATE) Q REBAL
|
---|
| 23 | S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0))
|
---|
| 24 | S RDATA=$G(^RMPR(661.9,RI,0))
|
---|
| 25 | S REBAL=$P(RDATA,U,9)
|
---|
| 26 | Q REBAL
|
---|
| 27 | ;
|
---|
| 28 | ;
|
---|
| 29 | CVAL(RX) ;CURRENT total Value
|
---|
| 30 | ;The Current total Value is the total value based on the date specified.
|
---|
| 31 | ;If the Date specified has no entry, the Current Total Value will be
|
---|
| 32 | ;extracted from the previous date entry. If it has no previous entry,
|
---|
| 33 | ;the Current Total Value will be set to ZERO.
|
---|
| 34 | ;
|
---|
| 35 | ;pass variable station, hcpcs, hcpcs item and date in RX local array.
|
---|
| 36 | ; RX("STA") = station
|
---|
| 37 | ; RX("HCP") = HCPCS
|
---|
| 38 | ; RX("ITE") = HCPCS item
|
---|
| 39 | ; RX("RDT") = date (current date)
|
---|
| 40 | ; REBAL = return variable (Current Total value based on the date)
|
---|
| 41 | N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
|
---|
| 42 | S REBAL=0
|
---|
| 43 | S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT")
|
---|
| 44 | Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL
|
---|
| 45 | S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD,0))
|
---|
| 46 | I '$G(RI) D I '$G(RI) Q REBAL
|
---|
| 47 | .S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1)
|
---|
| 48 | .S:$G(RDATE) RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0))
|
---|
| 49 | S RDATA=$G(^RMPR(661.9,RI,0))
|
---|
| 50 | S REBAL=$P(RDATA,U,9)
|
---|
| 51 | Q REBAL
|
---|
| 52 | ;
|
---|
| 53 | ;
|
---|
| 54 | SQTY(RX) ;STARTING total Quantity.
|
---|
| 55 | ;The Starting total Quantity is the Total qty of the previous entry
|
---|
| 56 | ;date specified. If no previous entry, the Total qty will
|
---|
| 57 | ;be set to ZERO.
|
---|
| 58 | ;
|
---|
| 59 | ;pass variable station, hcpcs, hcpcs item and date in RX local array.
|
---|
| 60 | ; RX("STA") = station
|
---|
| 61 | ; RX("HCP") = HCPCS
|
---|
| 62 | ; RX("ITE") = HCPCS item
|
---|
| 63 | ; RX("RDT") = date (starting date)
|
---|
| 64 | ; REBAL = return variable (Starting Total qty based on the date)
|
---|
| 65 | N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
|
---|
| 66 | S REBAL=0
|
---|
| 67 | S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT")
|
---|
| 68 | Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL
|
---|
| 69 | S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1)
|
---|
| 70 | I '$G(RDATE) Q REBAL
|
---|
| 71 | S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0))
|
---|
| 72 | S RDATA=$G(^RMPR(661.9,RI,0))
|
---|
| 73 | S REBAL=$P(RDATA,U,8)
|
---|
| 74 | Q REBAL
|
---|
| 75 | ;
|
---|
| 76 | ;
|
---|
| 77 | CQTY(RX) ;CURRENT total QTY
|
---|
| 78 | ;The Current total qty is the total qty based on the date specified.
|
---|
| 79 | ;If the Date specified has no entry, the Current Total qty will be
|
---|
| 80 | ;extracted from the previous date entry. If it has no previous entry,
|
---|
| 81 | ;the Current Total qty will be set to ZERO.
|
---|
| 82 | ;
|
---|
| 83 | ;pass variable station, hcpcs, hcpcs item and date in RX local array.
|
---|
| 84 | ; RX("STA") = station
|
---|
| 85 | ; RX("HCP") = HCPCS
|
---|
| 86 | ; RX("ITE") = HCPCS item
|
---|
| 87 | ; RX("RDT") = date (current date)
|
---|
| 88 | ; REBAL = return variable (Current Total qty based on the date)
|
---|
| 89 | N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
|
---|
| 90 | S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT")
|
---|
| 91 | Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL
|
---|
| 92 | S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD,0))
|
---|
| 93 | I '$G(RI) D I '$G(RI) Q REBAL
|
---|
| 94 | .S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1)
|
---|
| 95 | .S:$G(RDATE) RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0))
|
---|
| 96 | S RDATA=$G(^RMPR(661.9,RI,0))
|
---|
| 97 | S REBAL=$P(RDATA,U,8)
|
---|
| 98 | Q REBAL
|
---|
| 99 | ;
|
---|
| 100 | TVAQT ;get total qty and cost from 661.7
|
---|
| 101 | N R7I,R7J,R7DAT,R7QBAL,R7CBAL
|
---|
| 102 | S (RMPRQBAL,RMPRCBAL)=0
|
---|
| 103 | F R7I=0:0 S R7I=$O(^RMPR(661.7,"XSHIDS",RS,RH,RM,R7I)) Q:R7I'>0 F R7J=0:0 S R7J=$O(^RMPR(661.7,"XSHIDS",RS,RH,RM,R7I,1,R7J)) Q:R7J'>0 D
|
---|
| 104 | .S R7DAT=$G(^RMPR(661.7,R7J,0))
|
---|
| 105 | .S R7QBAL=$P(R7DAT,U,7)
|
---|
| 106 | .S R7CBAL=$P(R7DAT,U,8)
|
---|
| 107 | .I $G(R7QBAL) S RMPRQBAL=RMPRQBAL+R7QBAL
|
---|
| 108 | .I $G(R7CBAL) S RMPRCBAL=RMPRCBAL+R7CBAL
|
---|
| 109 | Q
|
---|
| 110 | ;
|
---|
| 111 | UPCR(RX) ;UPDATE or CREATE entry in 661.9
|
---|
| 112 | ;If an entry already exist, this subroutine will update the entry.
|
---|
| 113 | ;If no entry exist, this subroutine will create an entry.
|
---|
| 114 | ;The calling routine should check if $G(RMERROR), then error occured.
|
---|
| 115 | ;
|
---|
| 116 | ;pass variable station, hcpcs, hcpcs item, date, total quantity
|
---|
| 117 | ;and total cost in RX local array.
|
---|
| 118 | ; RX("STA") = station
|
---|
| 119 | ; RX("HCP") = HCPCS
|
---|
| 120 | ; RX("ITE") = HCPCS item
|
---|
| 121 | ; RX("RDT") = date
|
---|
| 122 | ; RX("TQTY")= net quantity to add to balance
|
---|
| 123 | ; RX("TCST")= net cost to add to balance
|
---|
| 124 | N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
|
---|
| 125 | N RMPRCBAL,RMPRQBAL
|
---|
| 126 | S RMERROR=0
|
---|
| 127 | S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT")
|
---|
| 128 | S RQ=RX("TQTY"),RC=$J(RX("TCST"),0,2)
|
---|
| 129 | I (RS="")!(RH="")!(RD="") S RMERROR=1 Q RMERROR
|
---|
| 130 | S (RMPRQBAL,RMPRCBAL)="" ;init quantity and cost balances
|
---|
| 131 | L +^RMPR(661.9,"ASHID",RS,RH,RM)
|
---|
| 132 | UPCRA K RI,RMDAT,RMERR,RDATA
|
---|
| 133 | ;get the current total quntity and cost from 661.7.
|
---|
| 134 | D TVAQT
|
---|
| 135 | S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD,0))
|
---|
| 136 | ;if there is an entry, update totals: (balance & cost).
|
---|
| 137 | I $G(RI) D
|
---|
| 138 | .S RDATA=$G(^RMPR(661.9,RI,0))
|
---|
| 139 | .;S RMPRQBAL=$P(RDATA,U,8)
|
---|
| 140 | .;S RMPRCBAL=$P(RDATA,U,9)
|
---|
| 141 | .S RMDAT(661.9,RI_",",.01)=RD
|
---|
| 142 | .S RMDAT(661.9,RI_",",1)=RH
|
---|
| 143 | .S RMDAT(661.9,RI_",",2)=RM
|
---|
| 144 | .S RMDAT(661.9,RI_",",4)=RS
|
---|
| 145 | .S RMDAT(661.9,RI_",",7)=RMPRQBAL
|
---|
| 146 | .S RMDAT(661.9,RI_",",8)=RMPRCBAL
|
---|
| 147 | .D FILE^DIE("K","RMDAT","RMERR")
|
---|
| 148 | .I $D(RMERR) S RMERROR=1
|
---|
| 149 | ;if no entry, create an entry for the date being passed.
|
---|
| 150 | E D
|
---|
| 151 | .S RX("RDT")=RD
|
---|
| 152 | .S RMDAT(661.9,"+1,",.01)=RD
|
---|
| 153 | .S RMDAT(661.9,"+1,",1)=RH
|
---|
| 154 | .S RMDAT(661.9,"+1,",2)=RM
|
---|
| 155 | .S RMDAT(661.9,"+1,",4)=RS
|
---|
| 156 | .S RMDAT(661.9,"+1,",7)=RMPRQBAL
|
---|
| 157 | .S RMDAT(661.9,"+1,",8)=RMPRCBAL
|
---|
| 158 | .D UPDATE^DIE("","RMDAT","RI","RMERR")
|
---|
| 159 | .I $D(RMERR) S RMERROR=1
|
---|
| 160 | I RMERROR G UPCRU
|
---|
| 161 | ;
|
---|
| 162 | ; Get next date and continue update so that all subsequent
|
---|
| 163 | ; balances are correct
|
---|
| 164 | UPCRN S RD=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD))
|
---|
| 165 | I RD'="" G UPCRA
|
---|
| 166 | UPCRU L -^RMPR(661.9,"ASHID",RS,RH,RM)
|
---|
| 167 | UPCRX Q RMERROR
|
---|
| 168 | ;
|
---|
| 169 | ALLREC(RMA) ;reconcile all HCPCS in 661.9
|
---|
| 170 | Q:RMA'="TEST"
|
---|
| 171 | N RM11,RM11DAT,RX
|
---|
| 172 | S U="^",RMERR=0
|
---|
| 173 | S RX("TQTY")=0
|
---|
| 174 | S RX("TCST")=0
|
---|
| 175 | S RX("RDT")=DT
|
---|
| 176 | F RM11=0:0 S RM11=$O(^RMPR(661.11,RM11)) Q:RM11'>0 D
|
---|
| 177 | .S RM11DAT=^RMPR(661.11,RM11,0)
|
---|
| 178 | .S RX("HCP")=$P(RM11DAT,U,1)
|
---|
| 179 | .S RX("ITE")=$P(RM11DAT,U,2)
|
---|
| 180 | .S RX("STA")=$P(RM11DAT,U,4)
|
---|
| 181 | .W !,RX("HCP")," ",RX("ITE")," ",RX("STA")
|
---|
| 182 | .S RMERR=$$UPCR^RMPRPIXJ(.RX)
|
---|
| 183 | Q RMERR
|
---|
| 184 | ;
|
---|
| 185 | NVAR ;new all variables
|
---|
| 186 | N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL
|
---|
| 187 | N RMPRCBAL,RMPRQBAL
|
---|
| 188 | Q
|
---|