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 Oct 16, 2024@18:20:49 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
