ABMUCAPI ; IHS/SD/SDR - 3PB/UFMS CAN crosswalk API
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; New routine - v2.5 p12 SDD item 4.2
; Budget activity and Cost Center will be used along with the
; ASUFAC to find the CAN in the IE for UFMS. The CAN tables
; will be maintained in the IE.
;
EP(W,X,Y,Z) ;PEP - Returns BUDGET ACTIVITY^COST CENTER or -1 for ea. if
; it can't find effective entry
;w=insurer type
;x=clinic ptr
;y=date/time approved (FM format)
;z=ASUFAC for location
S ABMIT=W
S ABMC=$P($G(^DIC(40.7,X,0)),U,2) ;clinic code
S ABMDT=Y
S ABMASUF=Z
;
S U="^"
S ABMRTURN=""
;
;acct pt/federal loc
;S ABMACTPT=""
;S ABMFLOC=""
;S ABMTIEN=$O(^ABMUAPFL("C",ABMASUF,0))
;I +ABMTIEN'=0 D
;.S ABMEFDT=$P($G(^ABMUAPFL(ABMTIEN,0)),U,5)
;.S ABMENDT=$P($G(^ABMUAPFL(ABMTIEN,0)),U,6)
;.I (ABMEFDT=ABMDT!(ABMEFDT<ABMDT)),((ABMENDT="")!(ABMENDT>ABMDT)) D
;..S ABMACTPT=$P($G(^ABMUAPFL(ABMTIEN,0)),U,3)
;..S ABMFLOC=$P($G(^ABMUAPFL(ABMTIEN,0)),U,4)
;S ABMACTPT=$$FMT^ABMERUTL(ABMACTPT,"3NR")
;S ABMFLOC=$$FMT^ABMERUTL(ABMFLOC,"4NR")
;S ABMRTURN=ABMACTPT_ABMFLOC
;
;budget activity
S ABMTIEN=0
S ABMAFLG=0
S ABMAREA=$E(ABMASUF,1,2)
S ABMAREA=$O(^AUTTAREA("C",ABMAREA,0))
F S ABMTIEN=$O(^ABMUITBA("C",ABMAREA,ABMIT,ABMTIEN)) Q:+ABMTIEN=0 D Q:ABMAFLG=1
.S ABMREC=$G(^ABMUITBA(ABMTIEN,0))
.S ABMEFDT=$P(ABMREC,U,3)
.S ABMENDDT=$P(ABMREC,U,4)
.I (ABMEFDT=ABMDT!(ABMEFDT<ABMDT)),((ABMENDDT="")!(ABMENDDT>ABMDT)) D
..S ABMAFLG=1
S ABMRTURN=ABMRTURN_$$FMT^ABMERUTL($S(+ABMTIEN'=0:$P($G(^ABMUITBA(ABMTIEN,0)),U,2),1:""),"10R")
;
;cost center
S ABMAFLG=0
S ABMTIEN=0
S:$G(ABMC)="" ABMC="XX" ;default
F S ABMTIEN=$O(^ABMUCTCC("B",ABMC,ABMTIEN)) Q:+ABMTIEN=0 D Q:ABMAFLG=1
.S ABMREC=$G(^ABMUCTCC(ABMTIEN,0))
.S ABMEFDT=$P(ABMREC,U,4)
.S ABMENDDT=$P(ABMREC,U,5)
.I (ABMEFDT=ABMDT!(ABMEFDT<ABMDT)),((ABMENDDT="")!(ABMENDDT>ABMDT)) D
..S ABMAFLG=1
S ABMRTURN=ABMRTURN_$$FMT^ABMERUTL($S(+ABMTIEN'=0:$P($G(^ABMUCTCC(ABMTIEN,0)),U,3),1:""),"3R")
;
Q ABMRTURN
;
COSTCENT(X,Y) ;PEP - return cost center and cost center desc. only
;x=clinic ptr
;y=date/time approved (FM format)
S ABMC=$P($G(^DIC(40.7,X,0)),U,2) ;clinic code
S ABMDT=Y
;
S ABMAFLG=0
S ABMTIEN=0
S:$G(ABMC)="" ABMC="XX" ;default
F S ABMTIEN=$O(^ABMUCTCC("B",ABMC,ABMTIEN)) Q:+ABMTIEN=0 D Q:ABMAFLG=1
.S ABMREC=$G(^ABMUCTCC(ABMTIEN,0))
.S ABMEFDT=$P(ABMREC,U,4)
.S ABMENDDT=$P(ABMREC,U,5)
.I (ABMEFDT=ABMDT!(ABMEFDT<ABMDT)),((ABMENDDT="")!(ABMENDDT>ABMDT)) D
..S ABMAFLG=1
S:+ABMTIEN'=0 ABMRTURN=$P($G(^ABMUCTCC(ABMTIEN,0)),U,3)_"^"_$P($G(^ABMUCTCC(ABMTIEN,0)),U,6)
Q ABMRTURN
ABMUCAPI ; IHS/SD/SDR - 3PB/UFMS CAN crosswalk API
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; New routine - v2.5 p12 SDD item 4.2
+4 ; Budget activity and Cost Center will be used along with the
+5 ; ASUFAC to find the CAN in the IE for UFMS. The CAN tables
+6 ; will be maintained in the IE.
+7 ;
EP(W,X,Y,Z) ;PEP - Returns BUDGET ACTIVITY^COST CENTER or -1 for ea. if
+1 ; it can't find effective entry
+2 ;w=insurer type
+3 ;x=clinic ptr
+4 ;y=date/time approved (FM format)
+5 ;z=ASUFAC for location
+6 SET ABMIT=W
+7 ;clinic code
SET ABMC=$PIECE($GET(^DIC(40.7,X,0)),U,2)
+8 SET ABMDT=Y
+9 SET ABMASUF=Z
+10 ;
+11 SET U="^"
+12 SET ABMRTURN=""
+13 ;
+14 ;acct pt/federal loc
+15 ;S ABMACTPT=""
+16 ;S ABMFLOC=""
+17 ;S ABMTIEN=$O(^ABMUAPFL("C",ABMASUF,0))
+18 ;I +ABMTIEN'=0 D
+19 ;.S ABMEFDT=$P($G(^ABMUAPFL(ABMTIEN,0)),U,5)
+20 ;.S ABMENDT=$P($G(^ABMUAPFL(ABMTIEN,0)),U,6)
+21 ;.I (ABMEFDT=ABMDT!(ABMEFDT<ABMDT)),((ABMENDT="")!(ABMENDT>ABMDT)) D
+22 ;..S ABMACTPT=$P($G(^ABMUAPFL(ABMTIEN,0)),U,3)
+23 ;..S ABMFLOC=$P($G(^ABMUAPFL(ABMTIEN,0)),U,4)
+24 ;S ABMACTPT=$$FMT^ABMERUTL(ABMACTPT,"3NR")
+25 ;S ABMFLOC=$$FMT^ABMERUTL(ABMFLOC,"4NR")
+26 ;S ABMRTURN=ABMACTPT_ABMFLOC
+27 ;
+28 ;budget activity
+29 SET ABMTIEN=0
+30 SET ABMAFLG=0
+31 SET ABMAREA=$EXTRACT(ABMASUF,1,2)
+32 SET ABMAREA=$ORDER(^AUTTAREA("C",ABMAREA,0))
+33 FOR
SET ABMTIEN=$ORDER(^ABMUITBA("C",ABMAREA,ABMIT,ABMTIEN))
IF +ABMTIEN=0
QUIT
Begin DoDot:1
+34 SET ABMREC=$GET(^ABMUITBA(ABMTIEN,0))
+35 SET ABMEFDT=$PIECE(ABMREC,U,3)
+36 SET ABMENDDT=$PIECE(ABMREC,U,4)
+37 IF (ABMEFDT=ABMDT!(ABMEFDT<ABMDT))
IF ((ABMENDDT="")!(ABMENDDT>ABMDT))
Begin DoDot:2
+38 SET ABMAFLG=1
End DoDot:2
End DoDot:1
IF ABMAFLG=1
QUIT
+39 SET ABMRTURN=ABMRTURN_$$FMT^ABMERUTL($SELECT(+ABMTIEN'=0:$PIECE($GET(^ABMUITBA(ABMTIEN,0)),U,2),1:""),"10R")
+40 ;
+41 ;cost center
+42 SET ABMAFLG=0
+43 SET ABMTIEN=0
+44 ;default
IF $GET(ABMC)=""
SET ABMC="XX"
+45 FOR
SET ABMTIEN=$ORDER(^ABMUCTCC("B",ABMC,ABMTIEN))
IF +ABMTIEN=0
QUIT
Begin DoDot:1
+46 SET ABMREC=$GET(^ABMUCTCC(ABMTIEN,0))
+47 SET ABMEFDT=$PIECE(ABMREC,U,4)
+48 SET ABMENDDT=$PIECE(ABMREC,U,5)
+49 IF (ABMEFDT=ABMDT!(ABMEFDT<ABMDT))
IF ((ABMENDDT="")!(ABMENDDT>ABMDT))
Begin DoDot:2
+50 SET ABMAFLG=1
End DoDot:2
End DoDot:1
IF ABMAFLG=1
QUIT
+51 SET ABMRTURN=ABMRTURN_$$FMT^ABMERUTL($SELECT(+ABMTIEN'=0:$PIECE($GET(^ABMUCTCC(ABMTIEN,0)),U,3),1:""),"3R")
+52 ;
+53 QUIT ABMRTURN
+54 ;
COSTCENT(X,Y) ;PEP - return cost center and cost center desc. only
+1 ;x=clinic ptr
+2 ;y=date/time approved (FM format)
+3 ;clinic code
SET ABMC=$PIECE($GET(^DIC(40.7,X,0)),U,2)
+4 SET ABMDT=Y
+5 ;
+6 SET ABMAFLG=0
+7 SET ABMTIEN=0
+8 ;default
IF $GET(ABMC)=""
SET ABMC="XX"
+9 FOR
SET ABMTIEN=$ORDER(^ABMUCTCC("B",ABMC,ABMTIEN))
IF +ABMTIEN=0
QUIT
Begin DoDot:1
+10 SET ABMREC=$GET(^ABMUCTCC(ABMTIEN,0))
+11 SET ABMEFDT=$PIECE(ABMREC,U,4)
+12 SET ABMENDDT=$PIECE(ABMREC,U,5)
+13 IF (ABMEFDT=ABMDT!(ABMEFDT<ABMDT))
IF ((ABMENDDT="")!(ABMENDDT>ABMDT))
Begin DoDot:2
+14 SET ABMAFLG=1
End DoDot:2
End DoDot:1
IF ABMAFLG=1
QUIT
+15 IF +ABMTIEN'=0
SET ABMRTURN=$PIECE($GET(^ABMUCTCC(ABMTIEN,0)),U,3)_"^"_$PIECE($GET(^ABMUCTCC(ABMTIEN,0)),U,6)
+16 QUIT ABMRTURN
