- IBCERPT1 ;ALB/JEH - ELECTRONIC REPORT DISPOSITION ;21-FEB-01
- ;;2.0;INTEGRATED BILLING;**137**;21-MAR-1994
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- EN ; -- main entry
- D EN^VALM("IBCE ELEC REPORT DISP")
- Q
- ;
- INIT ; -- set up variables
- S U="^"
- D BLD
- Q
- ;
- BLD ; -- build list of reports
- N IBI,IBREC,IBDESC,IBDISP,IBREP,NUMBER,IBCNT,IBIEN,X
- S VALMCNT=0
- K ^TMP("IBREP DISP",$J),^TMP("IBREP DISP1",$J)
- S IBI=0,IBREP="",IBCNT=0
- F S IBREP=$O(^IBE(361.2,"B",IBREP)) Q:IBREP="" F S IBI=$O(^IBE(361.2,"B",IBREP,IBI)) Q:'IBI S IBCNT=IBCNT+1,IBREC=$G(^IBE(361.2,IBI,0)),^TMP("IBREP DISP",$J,IBCNT)=IBI_U_$P(IBREC,U)_U_$P(IBREC,U,2)_U_$P(IBREC,U,3)
- ;
- S IBCNT=0
- I '$D(^TMP("IBREP DISP",$J)) D
- . S (IBCNT,VALMCNT)=2
- . S ^TMP("IBREP DISP1",$J,1,0)=" "
- . S ^TMP("IBREP DISP1",$J,2,0)="No reports available for dispositioning"
- S IBI=0 F S IBI=$O(^TMP("IBREP DISP",$J,IBI)) Q:'IBI S IBREC=^(IBI) D
- . S IBCNT=IBCNT+1,X=""
- . S IBIEN=+$P(IBREC,U)
- . S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
- . S X=$$SETFLD^VALM1($P(IBREC,U,2),X,"REPORT")
- . S X=$$SETFLD^VALM1($P(IBREC,U,4),X,"DESC")
- . S X=$$SETFLD^VALM1($$EXPAND^IBTRE(361.2,.02,+$P(IBREC,U,3)),X,"DISP")
- . D SET(X)
- Q
- ;
- SET(X) ;list manager screen
- S VALMCNT=VALMCNT+1
- S ^TMP("IBREP DISP1",$J,VALMCNT,0)=X
- S ^TMP("IBREP DISP1",$J,"IDX",VALMCNT,IBCNT)=""
- S ^TMP("IBREP DISP1",$J,IBCNT)=VALMCNT_U_IBIEN
- Q
- EDIT ;
- N IBDA,DIE,DA,DR,Y
- D FULL^VALM1
- S IBDA=$$SEL(.IBDA)
- I 'IBDA G EDITQ
- S DIE="^IBE(361.2,",DR=".02"
- S IBDA=0 F S IBDA=$O(IBDA(IBDA)) Q:'IBDA!($D(Y)>0) D
- . S DA=$P(IBDA(IBDA),U) W !,"REPORT: "_$P(^IBE(361.2,DA,0),U)_"//"
- . D ^DIE W !
- D BLD
- EDITQ S VALMBCK="R"
- Q
- EXIT ; -- clean up and exit
- K ^TMP("IBREP DISP",$J),^TMP("IBREP DISP1",$J)
- D CLEAN^VALM10
- Q
- ;
- HDR ;
- Q
- SEL(IBDA) ;Select entry from list
- N IBZ,VALMY
- D EN^VALM2($G(XQORNOD(0)))
- S (IBZ,IBDA)=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IBZ=IBZ+1,IBDA(IBDA)=$P($G(^TMP("IBREP DISP1",$J,IBDA)),U,2)
- Q IBZ
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCERPT1 2095 printed Jan 18, 2025@03:13:36 Page 2
- IBCERPT1 ;ALB/JEH - ELECTRONIC REPORT DISPOSITION ;21-FEB-01
- +1 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-1994
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- EN ; -- main entry
- +1 DO EN^VALM("IBCE ELEC REPORT DISP")
- +2 QUIT
- +3 ;
- INIT ; -- set up variables
- +1 SET U="^"
- +2 DO BLD
- +3 QUIT
- +4 ;
- BLD ; -- build list of reports
- +1 NEW IBI,IBREC,IBDESC,IBDISP,IBREP,NUMBER,IBCNT,IBIEN,X
- +2 SET VALMCNT=0
- +3 KILL ^TMP("IBREP DISP",$JOB),^TMP("IBREP DISP1",$JOB)
- +4 SET IBI=0
- SET IBREP=""
- SET IBCNT=0
- +5 FOR
- SET IBREP=$ORDER(^IBE(361.2,"B",IBREP))
- if IBREP=""
- QUIT
- FOR
- SET IBI=$ORDER(^IBE(361.2,"B",IBREP,IBI))
- if 'IBI
- QUIT
- SET IBCNT=IBCNT+1
- SET IBREC=$GET(^IBE(361.2,IBI,0))
- SET ^TMP("IBREP DISP",$JOB,IBCNT)=IBI_U_$PIECE(IBREC,U)_U_$PIECE(IBREC,U,2)_U_$PIECE(IBREC,U,3)
- +6 ;
- +7 SET IBCNT=0
- +8 IF '$DATA(^TMP("IBREP DISP",$JOB))
- Begin DoDot:1
- +9 SET (IBCNT,VALMCNT)=2
- +10 SET ^TMP("IBREP DISP1",$JOB,1,0)=" "
- +11 SET ^TMP("IBREP DISP1",$JOB,2,0)="No reports available for dispositioning"
- End DoDot:1
- +12 SET IBI=0
- FOR
- SET IBI=$ORDER(^TMP("IBREP DISP",$JOB,IBI))
- if 'IBI
- QUIT
- SET IBREC=^(IBI)
- Begin DoDot:1
- +13 SET IBCNT=IBCNT+1
- SET X=""
- +14 SET IBIEN=+$PIECE(IBREC,U)
- +15 SET X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
- +16 SET X=$$SETFLD^VALM1($PIECE(IBREC,U,2),X,"REPORT")
- +17 SET X=$$SETFLD^VALM1($PIECE(IBREC,U,4),X,"DESC")
- +18 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(361.2,.02,+$PIECE(IBREC,U,3)),X,"DISP")
- +19 DO SET(X)
- End DoDot:1
- +20 QUIT
- +21 ;
- SET(X) ;list manager screen
- +1 SET VALMCNT=VALMCNT+1
- +2 SET ^TMP("IBREP DISP1",$JOB,VALMCNT,0)=X
- +3 SET ^TMP("IBREP DISP1",$JOB,"IDX",VALMCNT,IBCNT)=""
- +4 SET ^TMP("IBREP DISP1",$JOB,IBCNT)=VALMCNT_U_IBIEN
- +5 QUIT
- EDIT ;
- +1 NEW IBDA,DIE,DA,DR,Y
- +2 DO FULL^VALM1
- +3 SET IBDA=$$SEL(.IBDA)
- +4 IF 'IBDA
- GOTO EDITQ
- +5 SET DIE="^IBE(361.2,"
- SET DR=".02"
- +6 SET IBDA=0
- FOR
- SET IBDA=$ORDER(IBDA(IBDA))
- if 'IBDA!($DATA(Y)>0)
- QUIT
- Begin DoDot:1
- +7 SET DA=$PIECE(IBDA(IBDA),U)
- WRITE !,"REPORT: "_$PIECE(^IBE(361.2,DA,0),U)_"//"
- +8 DO ^DIE
- WRITE !
- End DoDot:1
- +9 DO BLD
- EDITQ SET VALMBCK="R"
- +1 QUIT
- EXIT ; -- clean up and exit
- +1 KILL ^TMP("IBREP DISP",$JOB),^TMP("IBREP DISP1",$JOB)
- +2 DO CLEAN^VALM10
- +3 QUIT
- +4 ;
- HDR ;
- +1 QUIT
- SEL(IBDA) ;Select entry from list
- +1 NEW IBZ,VALMY
- +2 DO EN^VALM2($GET(XQORNOD(0)))
- +3 SET (IBZ,IBDA)=0
- FOR
- SET IBDA=$ORDER(VALMY(IBDA))
- if 'IBDA
- QUIT
- SET IBZ=IBZ+1
- SET IBDA(IBDA)=$PIECE($GET(^TMP("IBREP DISP1",$JOB,IBDA)),U,2)
- +4 QUIT IBZ
- +5 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT