IBCSCU.m

IBCSCU	;ALB/MJB - MCCR SCREEN UTILITY ROUTINE  ;27 MAY 88 11:09

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

	;MAP TO DGCRSCU

	;

	S IBW=1,IBU="UNSPECIFIED",IBUN=IBU_" [NOT REQUIRED]",IBV=$S($D(IBV):IBV,1:1) D HOME^%ZIS

	;S IBWW1="X ""F Z2=1:1:(Z1-$L(Z)) S Z=Z_"""" """""" W Z Q"

	S (IBVO,IBVI)="" I $S('$D(IOST(0)):1,'$D(^DG(43,1,0)):1,'$P(^DG(43,1,0),"^",36):1,$D(^DG(43,1,"TERM",IOST(0))):1,1:0) G M

	;

	I $D(IOST(0)) S X="IOINHI;IOINLOW;IOINORM" D ENDR^%ZISS

	I $L(IOINHI),$L(IOINLOW) S IBVI=IOINHI,IBVO=$S(IOINORM]"":IOINORM,1:IBINLOW)

	D KILL^%ZISS

	;I $D(^%ZIS(2,IOST(0),7)) S I=^(7) I $L($P(I,"^",1)),$L($P(I,"^",2)) S IBVI=$P(I,"^",1),IBVO=$S($P(I,"^",3)]"":$P(I,"^",3),1:$P(I,"^",2))

	;

M	;I $L(IBVI_IBVO)>4 S X=80 X ^%ZOSF("RM")

	S IBWW="W:IBW ! S Z=$S(IBV:""<""_Z_"">"",$E(IBV1,Z):""<""_Z_"">"",1:""[""_Z_""]"") W:$E(Z)=""["" IBVI,Z,IBVO W:$E(Z)'=""["" Z Q"

	;S IBWW="W:IBW ! S Z=$S(IOST=""C-QUME""&($L(IBVI)'=2):Z,IBV:""<""_Z_"">"",$E(IBV1,Z):""<""_Z_"">"",1:""[""_Z_""]"") W:$E(Z)=""["" @IBVI,Z,@IBVO W:$E(Z)'=""["" Z Q"

	I $D(IBPAR) S IBV=0,IBVV="00000" Q

	S IBBNO=$P(^DGCR(399,IBIFN,0),"^",1)

	S IBVV=$S($P(^DGCR(399,IBIFN,0),"^",5)>2:"00010100",1:"00001010"),X="63266556"

	Q

H	;Screen Header

	S L="",$P(L,"=",80)=""

	I $D(IBH) S X="HELP SCREEN" W @IOF,!?(40-($L(X)\2)),IBVI,X,IBVO,!,L G HQ

	S X=$P("DEMOGRAPHIC^EMPLOYMENT^PAYER^EVENT - INPATIENT^EVENT - OUTPATIENT^BILLING - GENERAL^BILLING - GENERAL^BILLING - SPECIFIC","^",IBSR)_" INFORMATION",X1="SCREEN <"_+IBSR_">"

	S DGINPT=$S(($P(^DGCR(399,IBIFN,0),"^",5)<3):"Inpatient",1:"Outpatient")

	W @IOF,!,VADM(1),"   ",$P(VADM(2),"^",2),"   BILL#: ",IBBNO_" - "_DGINPT,?(79-$L(X1)),X1

	W !,L

	W !?(40-($L(X)\2)),IBVI,X,IBVO

HQ	K L,DGINPT Q

	;

A	;Format Address(es)

	N Y F I=IBA1:1:IBA1+2 I $P(IB(IBAD),U,I)]"" S IBA(IBA2)=$P(IB(IBAD),U,I),IBA2=IBA2+2

	I IBA2=1 S IBA(1)="STREET ADDRESS UNKNOWN",IBA2=IBA2+2

	S J=$S($D(^DIC(5,+$P(IB(IBAD),U,IBA1+4),0)):$P(^(0),U,2),1:""),J(1)=$P(IB(IBAD),U,IBA1+3),J(2)=$P(IB(IBAD),U,IBA1+11),IBA(IBA2)=$S(J(1)]""&(J]""):J(1)_", "_J,J(1)]"":J(1),J]"":J,1:"CITY/STATE UNKNOWN")

	S Y=$S(IBAD=.11!(IBAD=.121):$P(IB(IBAD),U,IBA1+11),IBAD=.25:$P($G(^DPT(+$G(DFN),.22)),U,6),IBAD=.311:$P($G(^DPT(+$G(DFN),.22)),U,5),1:"") D ZIPOUT^VAFADDR

	S IBA(IBA2)=IBA(IBA2)_" "_Y F I=0:0 S I=$O(IBA(I)) Q:I=""  S IBA(I)=$E(IBA(I),1,25)

	K IBA1,I,J Q

IBCSCU    ;ALB/MJB - MCCR SCREEN UTILITY ROUTINE  ;27 MAY 88 11:09

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;MAP TO DGCRSCU

 +5       ;

 +6        SET IBW=1

           SET IBU="UNSPECIFIED"

           SET IBUN=IBU_" [NOT REQUIRED]"

           SET IBV=$SELECT($DATA(IBV):IBV,1:1)

           DO HOME^%ZIS

 +7       ;S IBWW1="X ""F Z2=1:1:(Z1-$L(Z)) S Z=Z_"""" """""" W Z Q"

 +8        SET (IBVO,IBVI)=""

           IF $SELECT('$DATA(IOST(0)):1,'$DATA(^DG(43,1,0)):1,'$PIECE(^DG(43,1,0),"^",36):1,$DATA(^DG(43,1,"TERM",IOST(0))):1,1:0)

               GOTO M

 +9       ;

 +10       IF $DATA(IOST(0))

               SET X="IOINHI;IOINLOW;IOINORM"

               DO ENDR^%ZISS

 +11       IF $LENGTH(IOINHI)

               IF $LENGTH(IOINLOW)

                   SET IBVI=IOINHI

                   SET IBVO=$SELECT(IOINORM]"":IOINORM,1:IBINLOW)

 +12       DO KILL^%ZISS

 +13      ;I $D(^%ZIS(2,IOST(0),7)) S I=^(7) I $L($P(I,"^",1)),$L($P(I,"^",2)) S IBVI=$P(I,"^",1),IBVO=$S($P(I,"^",3)]"":$P(I,"^",3),1:$P(I,"^",2))

 +14      ;

M         ;I $L(IBVI_IBVO)>4 S X=80 X ^%ZOSF("RM")

 +1        SET IBWW="W:IBW ! S Z=$S(IBV:""<""_Z_"">"",$E(IBV1,Z):""<""_Z_"">"",1:""[""_Z_""]"") W:$E(Z)=""["" IBVI,Z,IBVO W:$E(Z)'=""["" Z Q"

 +2       ;S IBWW="W:IBW ! S Z=$S(IOST=""C-QUME""&($L(IBVI)'=2):Z,IBV:""<""_Z_"">"",$E(IBV1,Z):""<""_Z_"">"",1:""[""_Z_""]"") W:$E(Z)=""["" @IBVI,Z,@IBVO W:$E(Z)'=""["" Z Q"

 +3        IF $DATA(IBPAR)

               SET IBV=0

               SET IBVV="00000"

               QUIT 

 +4        SET IBBNO=$PIECE(^DGCR(399,IBIFN,0),"^",1)

 +5        SET IBVV=$SELECT($PIECE(^DGCR(399,IBIFN,0),"^",5)>2:"00010100",1:"00001010")

           SET X="63266556"

 +6        QUIT 

H         ;Screen Header

 +1        SET L=""

           SET $PIECE(L,"=",80)=""

 +2        IF $DATA(IBH)

               SET X="HELP SCREEN"

               WRITE @IOF,!?(40-($LENGTH(X)\2)),IBVI,X,IBVO,!,L

               GOTO HQ

 +3        SET X=$PIECE("DEMOGRAPHIC^EMPLOYMENT^PAYER^EVENT - INPATIENT^EVENT - OUTPATIENT^BILLING - GENERAL^BILLING - GENERAL^BILLING - SPECIFIC","^",IBSR)_" INFORMATION"

           SET X1="SCREEN <"_+IBSR_">"

 +4        SET DGINPT=$SELECT(($PIECE(^DGCR(399,IBIFN,0),"^",5)<3):"Inpatient",1:"Outpatient")

 +5        WRITE @IOF,!,VADM(1),"   ",$PIECE(VADM(2),"^",2),"   BILL#: ",IBBNO_" - "_DGINPT,?(79-$LENGTH(X1)),X1

 +6        WRITE !,L

 +7        WRITE !?(40-($LENGTH(X)\2)),IBVI,X,IBVO

HQ         KILL L,DGINPT

           QUIT 

 +1       ;

A         ;Format Address(es)

 +1        NEW Y

           FOR I=IBA1:1:IBA1+2

               IF $PIECE(IB(IBAD),U,I)]""

                   SET IBA(IBA2)=$PIECE(IB(IBAD),U,I)

                   SET IBA2=IBA2+2

 +2        IF IBA2=1

               SET IBA(1)="STREET ADDRESS UNKNOWN"

               SET IBA2=IBA2+2

 +3        SET J=$SELECT($DATA(^DIC(5,+$PIECE(IB(IBAD),U,IBA1+4),0)):$PIECE(^(0),U,2),1:"")

           SET J(1)=$PIECE(IB(IBAD),U,IBA1+3)

           SET J(2)=$PIECE(IB(IBAD),U,IBA1+11)

           SET IBA(IBA2)=$SELECT(J(1)]""&(J]""):J(1)_", "_J,J(1)]"":J(1),J]"":J,1:"CITY/STATE UNKNOWN")

 +4        SET Y=$SELECT(IBAD=.11!(IBAD=.121):$PIECE(IB(IBAD),U,IBA1+11),IBAD=.25:$PIECE($GET(^DPT(+$GET(DFN),.22)),U,6),IBAD=.311:$PIECE($GET(^DPT(+$GET(DFN),.22)),U,5),1:"")

           DO ZIPOUT^VAFADDR

 +5        SET IBA(IBA2)=IBA(IBA2)_" "_Y

           FOR I=0:0

               SET I=$ORDER(IBA(I))

               IF I=""

                   QUIT 

               SET IBA(I)=$EXTRACT(IBA(I),1,25)

 +6        KILL IBA1,I,J

           QUIT