source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIUK.m@ 636

RMPRPIUK ;HINCIO/ODJ - PIP CONVERSION UTILITIES (contd) ;3/8/01
 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
 Q
 ;
 ;***** REC - Create initial reconciliations
 ;            These will balance the Patient Issues just created
REC N RMPRGBL,RMPRS,RMPR6,RMPR11,RMPRDT,X1,X2,X,RMPRTIME,RMPR5,RMPR69
 N RMPR9
 I '$D(IO("Q")) D
 . W !,"Creating balancing reconciliations "
 . Q
 S RMPRGBL="^TMP("""_$J_""",""ISS"")"
REC1 S RMPRGBL=$Q(@RMPRGBL)
 I $QS(RMPRGBL,2)'="ISS" G RECX
 I $QS(RMPRGBL,1)'=$J G RECX
 I '$D(IO("Q")) D
 . W:$X=79 ! W "."
 . Q
 S RMPR11("STATION")=$QS(RMPRGBL,3)
 S RMPR11("STATION IEN")=RMPR11("STATION")
 S RMPR11("HCPCS")=$QS(RMPRGBL,4)
 S RMPR11("ITEM")=$QS(RMPRGBL,5)
 S RMPR6("LOCATION")=$QS(RMPRGBL,6)
 S RMPR5("IEN")=RMPR6("LOCATION")
 S RMPR6("VENDOR")=$QS(RMPRGBL,7)
 S RMPR6("VENDOR IEN")=RMPR6("VENDOR")
 S RMPR6("COMMENT")=""
 S RMPR6("USER")=DUZ
 S RMPRS=@RMPRGBL
 S RMPR6("QUANTITY")=$P(RMPRS,"^",1)
 S RMPR6("VALUE")=$P(RMPRS,"^",2)
 ;
 ; ensure initial reconciliation date is the first one
 S X1=$O(^RMPR(661.6,"XHDS",RMPR11("HCPCS"),""))
 S X1=$P(X1,".",1)
 S X2=-2
 D C^%DTC
 S RMPRDT=$P(X,".",1)
 ;
 ; compute DATE&TIME for initial reconciliation 
 S RMPR6("DATE&TIME")=""
 F  D  Q:RMPR6("DATE&TIME")'=""
 . D NOW^%DTC
 . S RMPRTIME=RMPRDT_"."_$P(%,".",2)
 . I $D(^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPRTIME)) H (1+$R(3)) Q
 . L +^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPRTIME):0 E  H (1+$R(3)) Q
 . S RMPR6("DATE&TIME")=RMPRTIME
 . Q
 ;
 ; create transaction
 S RMPR6("SEQUENCE")=1
 S RMPR6("TRAN TYPE")=9
 S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
 K RMPR69
 S RMPR69("TRANS IEN")=RMPR6("IEN")
 S RMPR69("GAIN/LOSS")=RMPR6("QUANTITY")
 S RMPR69("GAIN/LOSS VALUE")=RMPR6("VALUE")
 S RMPRERR=$$CRE^RMPRPIXB(.RMPR69)
 L -^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPR6("DATE&TIME"))
 G REC1
RECX Q
 ;
 ;***** BAL - update running balance file
BAL N RMPR6,RMPR9,RMPRDT,RMPRS,RMPRH,RMPRI,RMPRD,RMPRQ,RMPRV,RMPRX,RMPRY
 N RMPRIEN,RMPRFME
 I '$D(IO("Q")) D
 . W !,"Creating Running Balance file 661.9 "
 . Q
 S RMPRS=""
 F  S RMPRS=$O(^RMPR(661.6,"ASTHIDS",RMPRS)) Q:RMPRS=""  D
 . I '$D(IO("Q")) D
 .. W:$X=79 ! W "."
 .. Q
 . S RMPRH=""
 . F  S RMPRH=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH)) Q:RMPRH=""  D
 .. S RMPRI=""
 .. F  S RMPRI=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI)) Q:RMPRI=""  D
 ... Q:'$D(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI))
 ... S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI,""))
 ... S RMPRQ=0,RMPRV=0,RMPRX=""
 ... F  S RMPRX=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI,RMPRD,RMPRX)) Q:RMPRX=""  D
 .... S RMPRY=""
 .... F  S RMPRY=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI,RMPRD,RMPRX,RMPRY)) Q:RMPRY=""  D
 ..... S RMPR6=^RMPR(661.6,RMPRY,0)
 ..... S RMPRQ=RMPRQ+$P(RMPR6,"^",5)
 ..... S RMPRV=RMPRV+$P(RMPR6,"^",6)
 ..... Q
 .... Q
 ... I RMPRQ<0 S RMPRQ=0
 ... I RMPRV<0 S RMPRV=0
 ... K RMPR9,RMPRIEN,RMPRFME
 ... S RMPR9(661.9,"+1,",.01)=$P(RMPRD,".",1)
 ... S RMPR9(661.9,"+1,",1)=RMPRH
 ... S RMPR9(661.9,"+1,",2)=RMPRI
 ... S RMPR9(661.9,"+1,",4)=RMPRS
 ... S RMPR9(661.9,"+1,",7)=RMPRQ
 ... S RMPR9(661.9,"+1,",8)=RMPRV
 ... D UPDATE^DIE("","RMPR9","RMPRIEN","RMPRFME")
 ... F  S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI,RMPRD)) Q:RMPRD=""  D
 .... S RMPRX=""
 .... F  S RMPRX=$O(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI,RMPRD,RMPRX)) Q:RMPRX=""  D
 ..... S RMPRY=""
 ..... F  S RMPRY=$O(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI,RMPRD,RMPRX,RMPRY)) Q:RMPRY=""  D
 ...... S RMPR6=^RMPR(661.6,RMPRY,0)
 ...... S RMPRQ=RMPRQ-$P(RMPR6,"^",5)
 ...... S RMPRV=RMPRV-$P(RMPR6,"^",6)
 ...... Q
 ..... Q
 .... K RMPR9,RMPRIEN,RMPRFME
 .... I RMPRQ<0 S RMPRQ=0
 .... I RMPRV<0 S RMPRV=0
 .... S RMPR9(661.9,"+1,",.01)=$P(RMPRD,".",1)
 .... S RMPR9(661.9,"+1,",1)=RMPRH
 .... S RMPR9(661.9,"+1,",2)=RMPRI
 .... S RMPR9(661.9,"+1,",4)=RMPRS
 .... S RMPR9(661.9,"+1,",7)=RMPRQ
 .... S RMPR9(661.9,"+1,",8)=RMPRV
 .... D UPDATE^DIE("","RMPR9","RMPRIEN","RMPRFME")
 .... Q
 ... Q
 .. Q
 . Q
BALX Q