- 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
