- IBCSC11 ;ALB/MJB - MCCR SCREEN 11 (LOCAL SCREEN 11 SPECIFIC INFO) ;27 MAY 99 10:20
- ;;2.0;INTEGRATED BILLING;**447,473**;21-MAR-94;Build 29
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ; Copied from IBCSC9 to place LOCAL SCREEN last in the screen sequence. IB*2.0*447 BI
- ;
- EN N IBCOB,IBSCRN,IBANY,IBXERR
- S IBCOB=$$COBN^IBCEF(IBIFN),IBANY=1
- S IBSCRN=$$LOCSCRN(IBIFN) ;Find screen from file 353
- I IBSCRN="" S IBANY="No local screen has been defined for this form type"
- I '$D(^DGCR(399,IBIFN,"I"_IBCOB)),'$P($G(^DGCR(399,IBIFN,"M")),U,11) S IBANY="Bill must have insurance co or resp institution to use this screen"
- D ^IBCSCU S IBSR=11,IBSR1=""
- D H^IBCSCU
- N IBWW,Z,IBPARMS
- ;Call formatter to extract data for screen here ... read thru the array
- ; ^TMP("IBXDATA",$J,1,PG,LINE,COL)=DATA to 'display' the data fields
- S IBPARMS(1)="BILL-SEARCH",IBPARMS(3)=$S($$INPAT^IBCEF(IBIFN):"I",1:"O"),IBPARMS(2)=$P($G(^DGCR(399,IBIFN,"I"_IBCOB)),U)
- S IBWW=""
- K ^TMP("IBXDATA",$J),^TMP("IBXEDIT",$J),IBXERR
- D FPRE^IBCEFG7(+IBSCRN,0,.IBXERR) ;Form pre-processor
- I $D(IBXERR) S IBANY=IBXERR
- I IBANY D
- .N VADM
- .S IBANY=$$EXTRACT^IBCEFG(IBSCRN,IBIFN,1,.IBPARMS) S:'IBANY IBANY="No local data fields are needed for this bill type/insurance company"
- I IBANY D
- .F Z0=1:1:$O(^TMP("IBXDATA",$J,1,1,""),-1) W ! S Z1="" F S Z1=$O(^TMP("IBXDATA",$J,1,1,Z0,Z1)) Q:'Z1 S Z2=^(Z1),Z3="" S:$E(Z2)="[" Z3=+$P(Z2,"[",2),Z2=$P(Z2,"]",2,999) W ?Z1 W:Z3 "[",IBVI,Z3,IBVO,"]" W Z2
- .S IBV1=""
- .I $S($G(IBV)=1:0,1:$$STATOK^IBCEU4(IBIFN,"12")) S Z="" F S Z=$O(^TMP("IBXEDIT",$J,Z)) Q:'Z S $E(IBV1,Z)=0
- I 'IBANY S IBV1="1" W !!,IBANY
- G ^IBCSCP
- ;
- EDIT ;
- N Z,DR,DA,DIE,FLDS,Z0,IBCUFT
- S IBCUFT=$P($G(^DGCR(399,IBIFN,0)),U,19)
- F Z=1:1:$L(IBDR20,",") S Z0=$P(IBDR20,",",Z) D
- .S DR=""
- .S IBGRP=Z0-110,Z0=0 F S Z0=$O(^TMP("IBXEDIT",$J,IBGRP,Z0)) Q:'Z0 S DR=DR_$S($L(DR):";",1:"")_^(Z0)
- .I $L(DR) S DIE=+$G(^IBE(353,IBCUFT,2)),DA=IBIFN D ^DIE
- Q
- ;
- LOCSCRN(IBIFN) ; Find the local screen from the bill form type
- Q $P($G(^IBE(353,+$P($G(^DGCR(399,IBIFN,0)),U,19),2)),U,9)
- ;
- Q Q
- ;IBCSC11
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCSC11 2147 printed Jan 18, 2025@03:21:22 Page 2
- IBCSC11 ;ALB/MJB - MCCR SCREEN 11 (LOCAL SCREEN 11 SPECIFIC INFO) ;27 MAY 99 10:20
- +1 ;;2.0;INTEGRATED BILLING;**447,473**;21-MAR-94;Build 29
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ; Copied from IBCSC9 to place LOCAL SCREEN last in the screen sequence. IB*2.0*447 BI
- +5 ;
- EN NEW IBCOB,IBSCRN,IBANY,IBXERR
- +1 SET IBCOB=$$COBN^IBCEF(IBIFN)
- SET IBANY=1
- +2 ;Find screen from file 353
- SET IBSCRN=$$LOCSCRN(IBIFN)
- +3 IF IBSCRN=""
- SET IBANY="No local screen has been defined for this form type"
- +4 IF '$DATA(^DGCR(399,IBIFN,"I"_IBCOB))
- IF '$PIECE($GET(^DGCR(399,IBIFN,"M")),U,11)
- SET IBANY="Bill must have insurance co or resp institution to use this screen"
- +5 DO ^IBCSCU
- SET IBSR=11
- SET IBSR1=""
- +6 DO H^IBCSCU
- +7 NEW IBWW,Z,IBPARMS
- +8 ;Call formatter to extract data for screen here ... read thru the array
- +9 ; ^TMP("IBXDATA",$J,1,PG,LINE,COL)=DATA to 'display' the data fields
- +10 SET IBPARMS(1)="BILL-SEARCH"
- SET IBPARMS(3)=$SELECT($$INPAT^IBCEF(IBIFN):"I",1:"O")
- SET IBPARMS(2)=$PIECE($GET(^DGCR(399,IBIFN,"I"_IBCOB)),U)
- +11 SET IBWW=""
- +12 KILL ^TMP("IBXDATA",$JOB),^TMP("IBXEDIT",$JOB),IBXERR
- +13 ;Form pre-processor
- DO FPRE^IBCEFG7(+IBSCRN,0,.IBXERR)
- +14 IF $DATA(IBXERR)
- SET IBANY=IBXERR
- +15 IF IBANY
- Begin DoDot:1
- +16 NEW VADM
- +17 SET IBANY=$$EXTRACT^IBCEFG(IBSCRN,IBIFN,1,.IBPARMS)
- if 'IBANY
- SET IBANY="No local data fields are needed for this bill type/insurance company"
- End DoDot:1
- +18 IF IBANY
- Begin DoDot:1
- +19 FOR Z0=1:1:$ORDER(^TMP("IBXDATA",$JOB,1,1,""),-1)
- WRITE !
- SET Z1=""
- FOR
- SET Z1=$ORDER(^TMP("IBXDATA",$JOB,1,1,Z0,Z1))
- if 'Z1
- QUIT
- SET Z2=^(Z1)
- SET Z3=""
- if $EXTRACT(Z2)="["
- SET Z3=+$PIECE(Z2,"[",2)
- SET Z2=$PIECE(Z2,"]",2,999)
- WRITE ?Z1
- if Z3
- WRITE "[",IBVI,Z3,IBVO,"]"
- WRITE Z2
- +20 SET IBV1=""
- +21 IF $SELECT($GET(IBV)=1:0,1:$$STATOK^IBCEU4(IBIFN,"12"))
- SET Z=""
- FOR
- SET Z=$ORDER(^TMP("IBXEDIT",$JOB,Z))
- if 'Z
- QUIT
- SET $EXTRACT(IBV1,Z)=0
- End DoDot:1
- +22 IF 'IBANY
- SET IBV1="1"
- WRITE !!,IBANY
- +23 GOTO ^IBCSCP
- +24 ;
- EDIT ;
- +1 NEW Z,DR,DA,DIE,FLDS,Z0,IBCUFT
- +2 SET IBCUFT=$PIECE($GET(^DGCR(399,IBIFN,0)),U,19)
- +3 FOR Z=1:1:$LENGTH(IBDR20,",")
- SET Z0=$PIECE(IBDR20,",",Z)
- Begin DoDot:1
- +4 SET DR=""
- +5 SET IBGRP=Z0-110
- SET Z0=0
- FOR
- SET Z0=$ORDER(^TMP("IBXEDIT",$JOB,IBGRP,Z0))
- if 'Z0
- QUIT
- SET DR=DR_$SELECT($LENGTH(DR):";",1:"")_^(Z0)
- +6 IF $LENGTH(DR)
- SET DIE=+$GET(^IBE(353,IBCUFT,2))
- SET DA=IBIFN
- DO ^DIE
- End DoDot:1
- +7 QUIT
- +8 ;
- LOCSCRN(IBIFN) ; Find the local screen from the bill form type
- +1 QUIT $PIECE($GET(^IBE(353,+$PIECE($GET(^DGCR(399,IBIFN,0)),U,19),2)),U,9)
- +2 ;
- Q QUIT
- +1 ;IBCSC11