- IBAMTV31 ;ALB/CPM - LIST CHARGES PENDING REVIEW ; 03-JUN-94
- ;;Version 2.0 ; INTEGRATED BILLING ;**15,52**; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- SP ; 'Select Patient' entry action.
- N IBCOMMIT,IBNBR,IBBG
- S IBCOMMIT=0 D EN^VALM2($G(XQORNOD(0))) I '$O(VALMY(0)) G SPQ
- S IBNBR="" F S IBNBR=$O(VALMY(IBNBR)) Q:'IBNBR D
- .S DFN=^TMP("IBAMTV3",$J,"IDX",IBNBR,IBNBR) Q:'DFN
- .W !,"Generating a list of pending charges for ",$P($$PT^IBEFUNC(DFN),"^")," ..." H 2
- .N VALMHDR,VALMY S IBCOMMIT=1
- .D EN^VALM("IB MT REVIEW INDIV CHARGES")
- SPQ S VALMBCK=$S(IBCOMMIT:"R",1:"")
- I IBCOMMIT S IBBG=VALMBG D INIT^IBAMTV3 S VALMBG=IBBG
- Q
- ;
- HDR ; Build screen header.
- N IBPT,VA,VAEL,VAERR
- D ELIG^VADPT
- S IBPT=$$PT^IBEFUNC(DFN)
- S VALMHDR(1)="Release Charges 'Pending Review'"_$J("",21)_"List of all Pending Charges"
- S VALMHDR(2)=$$SETSTR^VALM1("Date","Patient: "_$P(IBPT,"^")_" "_$E(IBPT)_$P(IBPT,"^",3)_$S(VAEL(3):" **SC VETERAN**",1:""),69,4)
- Q
- ;
- INIT ; Build list.
- N IBAX,IBN,IBND,IBATYP,IBND1
- S VALMBG=1,VALMCNT=0,VALMBCK="R"
- K ^TMP("IBAMTV31",$J)
- S IBN=0 F S IBN=$O(^IB("AJ",DFN,IBN)) Q:'IBN D
- .S IBND=$G(^IB(IBN,0)),IBND1=$G(^(1)) Q:'IBND!'IBND1
- .S VALMCNT=VALMCNT+1
- .S IBATYP=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^") S:$E(IBATYP,1,2)="DG" IBATYP=$E(IBATYP,4,99)
- .S IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($P(IBND,"^",14)),VALMCNT,+$P(VALMDDF("FDATE"),"^",2),+$P(VALMDDF("FDATE"),"^",3))
- .S IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($P(IBND,"^",15)),IBAX,+$P(VALMDDF("TDATE"),"^",2),+$P(VALMDDF("TDATE"),"^",3))
- .S IBAX=$$SETSTR^VALM1(IBATYP,IBAX,+$P(VALMDDF("TYPE"),"^",2),+$P(VALMDDF("TYPE"),"^",3))
- .S IBAX=$$SETSTR^VALM1("$"_$P(IBND,"^",7),IBAX,+$P(VALMDDF("AMOUNT"),"^",2),+$P(VALMDDF("AMOUNT"),"^",3))
- .S IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($P(IBND1,"^",2)\1),IBAX,+$P(VALMDDF("CREATED"),"^",2),+$P(VALMDDF("CREATED"),"^",3))
- .S ^TMP("IBAMTV31",$J,VALMCNT,0)=IBAX
- .S ^TMP("IBAMTV31",$J,"IDX",VALMCNT,VALMCNT)=IBN
- I '$D(^TMP("IBAMTV31",$J)) S ^TMP("IBAMTV31",$J,1,0)=" ",^TMP("IBAMTV31",$J,2,0)=" There are no charges pending review for this patient.",VALMCNT=2
- Q
- ;
- HELP ; Help code.
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; Exit action.
- K ^TMP("IBAMTV31",$J)
- D FULL^VALM1,CLEAN^VALM10
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTV31 2297 printed Feb 18, 2025@23:33:13 Page 2
- IBAMTV31 ;ALB/CPM - LIST CHARGES PENDING REVIEW ; 03-JUN-94
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;**15,52**; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- SP ; 'Select Patient' entry action.
- +1 NEW IBCOMMIT,IBNBR,IBBG
- +2 SET IBCOMMIT=0
- DO EN^VALM2($GET(XQORNOD(0)))
- IF '$ORDER(VALMY(0))
- GOTO SPQ
- +3 SET IBNBR=""
- FOR
- SET IBNBR=$ORDER(VALMY(IBNBR))
- if 'IBNBR
- QUIT
- Begin DoDot:1
- +4 SET DFN=^TMP("IBAMTV3",$JOB,"IDX",IBNBR,IBNBR)
- if 'DFN
- QUIT
- +5 WRITE !,"Generating a list of pending charges for ",$PIECE($$PT^IBEFUNC(DFN),"^")," ..."
- HANG 2
- +6 NEW VALMHDR,VALMY
- SET IBCOMMIT=1
- +7 DO EN^VALM("IB MT REVIEW INDIV CHARGES")
- End DoDot:1
- SPQ SET VALMBCK=$SELECT(IBCOMMIT:"R",1:"")
- +1 IF IBCOMMIT
- SET IBBG=VALMBG
- DO INIT^IBAMTV3
- SET VALMBG=IBBG
- +2 QUIT
- +3 ;
- HDR ; Build screen header.
- +1 NEW IBPT,VA,VAEL,VAERR
- +2 DO ELIG^VADPT
- +3 SET IBPT=$$PT^IBEFUNC(DFN)
- +4 SET VALMHDR(1)="Release Charges 'Pending Review'"_$JUSTIFY("",21)_"List of all Pending Charges"
- +5 SET VALMHDR(2)=$$SETSTR^VALM1("Date","Patient: "_$PIECE(IBPT,"^")_" "_$EXTRACT(IBPT)_$PIECE(IBPT,"^",3)_$SELECT(VAEL(3):" **SC VETERAN**",1:""),69,4)
- +6 QUIT
- +7 ;
- INIT ; Build list.
- +1 NEW IBAX,IBN,IBND,IBATYP,IBND1
- +2 SET VALMBG=1
- SET VALMCNT=0
- SET VALMBCK="R"
- +3 KILL ^TMP("IBAMTV31",$JOB)
- +4 SET IBN=0
- FOR
- SET IBN=$ORDER(^IB("AJ",DFN,IBN))
- if 'IBN
- QUIT
- Begin DoDot:1
- +5 SET IBND=$GET(^IB(IBN,0))
- SET IBND1=$GET(^(1))
- if 'IBND!'IBND1
- QUIT
- +6 SET VALMCNT=VALMCNT+1
- +7 SET IBATYP=$PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^")
- if $EXTRACT(IBATYP,1,2)="DG"
- SET IBATYP=$EXTRACT(IBATYP,4,99)
- +8 SET IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($PIECE(IBND,"^",14)),VALMCNT,+$PIECE(VALMDDF("FDATE"),"^",2),+$PIECE(VALMDDF("FDATE"),"^",3))
- +9 SET IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($PIECE(IBND,"^",15)),IBAX,+$PIECE(VALMDDF("TDATE"),"^",2),+$PIECE(VALMDDF("TDATE"),"^",3))
- +10 SET IBAX=$$SETSTR^VALM1(IBATYP,IBAX,+$PIECE(VALMDDF("TYPE"),"^",2),+$PIECE(VALMDDF("TYPE"),"^",3))
- +11 SET IBAX=$$SETSTR^VALM1("$"_$PIECE(IBND,"^",7),IBAX,+$PIECE(VALMDDF("AMOUNT"),"^",2),+$PIECE(VALMDDF("AMOUNT"),"^",3))
- +12 SET IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($PIECE(IBND1,"^",2)\1),IBAX,+$PIECE(VALMDDF("CREATED"),"^",2),+$PIECE(VALMDDF("CREATED"),"^",3))
- +13 SET ^TMP("IBAMTV31",$JOB,VALMCNT,0)=IBAX
- +14 SET ^TMP("IBAMTV31",$JOB,"IDX",VALMCNT,VALMCNT)=IBN
- End DoDot:1
- +15 IF '$DATA(^TMP("IBAMTV31",$JOB))
- SET ^TMP("IBAMTV31",$JOB,1,0)=" "
- SET ^TMP("IBAMTV31",$JOB,2,0)=" There are no charges pending review for this patient."
- SET VALMCNT=2
- +16 QUIT
- +17 ;
- HELP ; Help code.
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; Exit action.
- +1 KILL ^TMP("IBAMTV31",$JOB)
- +2 DO FULL^VALM1
- DO CLEAN^VALM10
- +3 QUIT