IBYOPOS1 ;ALB/TMP - IB*2*51 POST-INSTALL ;22-JAN-96
;;2.0;INTEGRATED BILLING;**51**;21-MAR-94
;
ADDFORMS ; Add the local forms for HCFA 1500 and UB92 if they don't
; already exist
; Sets up local forms as defaults for form prints
; HCFA 1500 and UB-92
D MES^XPDUTL("Setting up local form defaults for bill forms.")
N IB2,IBFORM,IBFORMNM,IBLOC,IBLOCN,IBTEXT,DO,DD,DIC,DIE,DINUM,DR,X,Y,Z,Z0,Z1
;
F IBFORM=2,3 S Z=$P($G(^IBE(353,IBFORM,2)),U,8) D
. K IBTEXT
. I 'Z D
.. S IBFORMNM=$S(IBFORM=2:"HCFA 1500",1:"UB-92")
.. S IBLOCN="LOCAL "_IBFORMNM_" (AUTO-ADDED)"
.. S IB2=$G(^IBE(353,IBFORM,2))
.. S IBLOC=+$O(^IBE(353,"B",IBLOCN,0))
.. I IBLOC D MES^XPDUTL("Form "_IBLOCN_" already exists - not added again")
.. I 'IBLOC D
... F Z0=1:1:5 L +^IBE(353,0):1 Q:$T
... I '$T S IBTEXT(1)=" Problem adding local print form for "_IBFORMNM,IBTEXT(2)=" Please add this form manually" D ERRMSG^IBYOPOST(.IBTEXT) Q
... D MES^XPDUTL("Adding form '"_IBLOCN_"' to form file.")
... S Z1=$O(^IBE(353,"A"),-1) I Z1<10000 S Z1=9999
... S Z1=Z1+1,DINUM=Z1,DLAYGO=353,DIC="^IBE(353,",DIC(0)="L",X=IBLOCN
... S DIC("DR")="2.01////399;2.02////P;2.03////"_$P(IB2,U,3)_";2.04////0;2.05////"_IBFORM_";2.06////"_IBLOCN
... D FILE^DICN K DO,DD,DIC,DLAYGO,DINUM
... L -^IBE(353,0)
... I Y<0 S IBTEXT(1)=" Problem adding local print form for "_IBFORMNM,IBTEXT(2)=" Please add the form manually using the output formatter" D ERRMSG^IBYOPOST(.IBTEXT) Q
... S IBLOC=+Y
.. ;
.. D MES^XPDUTL("Updating "_IBFORMNM_"'s PRINT FORM field with "_IBLOCN_".")
.. S DIE="^IBE(353,",DA=IBFORM,DR="2.08////"_IBLOC D ^DIE
.. I '$P($G(^IBE(353,IBFORM,2)),U,8) S IBTEXT(1)=" Problem updating "_IBFORMNM_"'s PRINT FORM data",IBTEXT(2)=" Please update this form definition manually so your bills print correctly" D ERRMSG^IBYOPOST(.IBTEXT) Q
;
S Z=8 F S Z=$O(^IBE(Z)) Q:'Z I $P($G(^IBE(353,Z,2)),U,2)="S" D
. S DR="2.05////"_Z,DIE="^IBE(353,",DA=Z D ^DIE
D COMPLETE^IBYOPOST
;
D BMES^XPDUTL("Post install complete.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYOPOS1 2052 printed Nov 22, 2024@17:45:48 Page 2
IBYOPOS1 ;ALB/TMP - IB*2*51 POST-INSTALL ;22-JAN-96
+1 ;;2.0;INTEGRATED BILLING;**51**;21-MAR-94
+2 ;
ADDFORMS ; Add the local forms for HCFA 1500 and UB92 if they don't
+1 ; already exist
+2 ; Sets up local forms as defaults for form prints
+3 ; HCFA 1500 and UB-92
+4 DO MES^XPDUTL("Setting up local form defaults for bill forms.")
+5 NEW IB2,IBFORM,IBFORMNM,IBLOC,IBLOCN,IBTEXT,DO,DD,DIC,DIE,DINUM,DR,X,Y,Z,Z0,Z1
+6 ;
+7 FOR IBFORM=2,3
SET Z=$PIECE($GET(^IBE(353,IBFORM,2)),U,8)
Begin DoDot:1
+8 KILL IBTEXT
+9 IF 'Z
Begin DoDot:2
+10 SET IBFORMNM=$SELECT(IBFORM=2:"HCFA 1500",1:"UB-92")
+11 SET IBLOCN="LOCAL "_IBFORMNM_" (AUTO-ADDED)"
+12 SET IB2=$GET(^IBE(353,IBFORM,2))
+13 SET IBLOC=+$ORDER(^IBE(353,"B",IBLOCN,0))
+14 IF IBLOC
DO MES^XPDUTL("Form "_IBLOCN_" already exists - not added again")
+15 IF 'IBLOC
Begin DoDot:3
+16 FOR Z0=1:1:5
LOCK +^IBE(353,0):1
if $TEST
QUIT
+17 IF '$TEST
SET IBTEXT(1)=" Problem adding local print form for "_IBFORMNM
SET IBTEXT(2)=" Please add this form manually"
DO ERRMSG^IBYOPOST(.IBTEXT)
QUIT
+18 DO MES^XPDUTL("Adding form '"_IBLOCN_"' to form file.")
+19 SET Z1=$ORDER(^IBE(353,"A"),-1)
IF Z1<10000
SET Z1=9999
+20 SET Z1=Z1+1
SET DINUM=Z1
SET DLAYGO=353
SET DIC="^IBE(353,"
SET DIC(0)="L"
SET X=IBLOCN
+21 SET DIC("DR")="2.01////399;2.02////P;2.03////"_$PIECE(IB2,U,3)_";2.04////0;2.05////"_IBFORM_";2.06////"_IBLOCN
+22 DO FILE^DICN
KILL DO,DD,DIC,DLAYGO,DINUM
+23 LOCK -^IBE(353,0)
+24 IF Y<0
SET IBTEXT(1)=" Problem adding local print form for "_IBFORMNM
SET IBTEXT(2)=" Please add the form manually using the output formatter"
DO ERRMSG^IBYOPOST(.IBTEXT)
QUIT
+25 SET IBLOC=+Y
End DoDot:3
+26 ;
+27 DO MES^XPDUTL("Updating "_IBFORMNM_"'s PRINT FORM field with "_IBLOCN_".")
+28 SET DIE="^IBE(353,"
SET DA=IBFORM
SET DR="2.08////"_IBLOC
DO ^DIE
+29 IF '$PIECE($GET(^IBE(353,IBFORM,2)),U,8)
SET IBTEXT(1)=" Problem updating "_IBFORMNM_"'s PRINT FORM data"
SET IBTEXT(2)=" Please update this form definition manually so your bills print correctly"
DO ERRMSG^IBYOPOST(.IBTEXT)
QUIT
End DoDot:2
End DoDot:1
+30 ;
+31 SET Z=8
FOR
SET Z=$ORDER(^IBE(Z))
if 'Z
QUIT
IF $PIECE($GET(^IBE(353,Z,2)),U,2)="S"
Begin DoDot:1
+32 SET DR="2.05////"_Z
SET DIE="^IBE(353,"
SET DA=Z
DO ^DIE
End DoDot:1
+33 DO COMPLETE^IBYOPOST
+34 ;
+35 DO BMES^XPDUTL("Post install complete.")
+36 QUIT
+37 ;
