IBYPPOST ; ALB/TMP - IB*2*52 POST-INIT ; 22-JAN-96
;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
;
POST ;
D OGEN ; output generator post init
D START^IBYPPC ; charge master post init
D ACTTYP ; add action types to file #350.1
D MGRP ; add new mailgroups
Q
;
;
OGEN ;Set up check points for post-init
N %,Z
S %=$$NEWCP^XPDUTL("U399","U399^IBYPPOST")
S %=$$NEWCP^XPDUTL("U353","U353^IBYPPOST")
Q
;
U399 N DONE,S1,Z,Z1,CT,%
S DONE="Step Complete.",CT=0
S S1=+$$PARCP^XPDUTL("U399")
D BMES^XPDUTL("Updating Bill/Claims file")
F S S1=$O(^DGCR(399,S1)) Q:'S1 S Z=$G(^DGCR(399,S1,0)),Z1=$P(Z,U,11) D
.S CT=CT+1
.I $P(Z,U,13)<2!$P(Z,U,13)>4!($P(Z,U,21)'="")!$S(Z1="":1,1:"pi"'[Z1) S:'(CT#200) %=$$UPCP^XPDUTL("U399",S1) Q
.S Z1=$S(Z1="p":"A",Z1="i":"P",1:"") S:Z1'="" $P(^(0),U,21)=Z1 S:'(CT#200) %=$$UPCP^XPDUTL("U399",S1)
D MES^XPDUTL(DONE)
Q
;
U353 N DONE,Z
S DONE="Step Complete."
D BMES^XPDUTL("Updating Bill Form Type file")
F Z=2,3 I $G(^IBE(353,Z,2))="" S ^IBE(353,Z,2)="399^P^66^1",^("PRE")="D ENTPRE^IBCFP1",^("POST")="D ENTPOST^IBCFP1",^("EXT")="D QB1^IBCFP1",^("FPRE")="D FORMPRE^IBCFP1",^("FPOST")="D FORMPOST^IBCFP1"
S Z=0 F S Z=$O(^IBE(353,Z)) Q:'Z I $P($G(^(Z,2)),U,2)="" S $P(^IBE(353,Z,2),U,2)="P"
I $P($G(^IBE(353,2,2)),U,6)="" S $P(^IBE(353,2,2),U,6)="NATIONAL HCFA-1500",$P(^IBE(353,3,2),U,6)="NATIONAL UB-92"
D MES^XPDUTL(DONE)
Q
;
;
ACTTYP ; Add Action Types
D BMES^XPDUTL(" ")
D BMES^XPDUTL(">>> Adding new IB Action Types into file #350.1...")
;
; - get IBAR
S IBAR=$O(^PRCA(430.2,"B","CHAMPUS PATIENT",0))
I 'IBAR D BMES^XPDUTL(" >> Can't add action types! Install PRCA*4.5*48 first!") G ACTTYPQ
;
; - get rx serv
S IBSERV=$P($G(^IBE(350.1,1,0)),"^",4)
I '$$SERV^IBARX1(IBSERV) D BMES^XPDUTL(" >> Please check entry #1 in file #350.1 - the service should be Pharmacy.") G ACTTYPQ
;
; - add action types
D NEWAT
;
; - point them to the correct action types
D ATAT
;
ACTTYPQ K IBAR,IBSERV
Q
;
;
NEWAT ; Add new IB Action Types into file #350.1
F IBI=1:1 S IBCR=$P($T(NAT+IBI),";;",2) Q:IBCR="QUIT" D
.S X=$P(IBCR,"^")
.S $P(IBCR,"^",3,4)=IBAR_"^"_IBSERV
.I $O(^IBE(350.1,"B",X,0)) D BMES^XPDUTL(" >> '"_X_"' is already on file...") Q
.K DD,DO S DIC="^IBE(350.1,",DIC(0)="" D FILE^DICN Q:Y<0
.S ^(0)=^IBE(350.1,+Y,0)_"^"_$P(IBCR,"^",2,11) S DIK=DIC,DA=+Y D IX1^DIK
.D BMES^XPDUTL(" >> '"_$P(IBCR,"^")_"' has been filed...")
K DA,DIC,DIE,DR,IBI,IBCR,X,Y
Q
;
NAT ; Action Types to add into file #350.1
;;DG CHAMPUS RX COPAY NEW^CUS RX^^^1^^^CHAMPUS RX COPAY^^^7
;;DG CHAMPUS OPT COPAY NEW^CUS OPT^^^1^^^CHAMPUS OPT COPAY^^^7
;;DG CHAMPUS INPT COPAY NEW^CUS INPT^^^1^^^CHAMPUS INPT COPAY^^^7
;;DG CHAMPUS RX COPAY CANCEL^CAN CRX^^^2
;;DG CHAMPUS OPT COPAY CANCEL^CAN COPT^^^2
;;DG CHAMPUS INPT COPAY CANCEL^CAN CINP^^^2
;;QUIT
;
;
ATAT ; Resolve pointers to file #350.1 from file #350.1
F IBI=1:1 S IBX=$P($T(ACT+IBI),";;",2,99) Q:IBX="QUIT" D
.S IBNEW=$O(^IBE(350.1,"B",$P(IBX,"^"),0))
.S IBCAN=$O(^IBE(350.1,"B",$P(IBX,"^",2),0))
.F IBJ=IBNEW,IBCAN D
..S DIE="^IBE(350.1,",DA=IBJ
..S DR=".06////"_IBCAN_";.09////"_IBNEW
..D ^DIE K DA,DR,DIE
;
K IBI,IBX,IBNEW,IBCAN,IBJ
Q
;
;
ACT ;New Action (#350.1)^Cancel Action (#350.1)
;;DG CHAMPUS RX COPAY NEW^DG CHAMPUS RX COPAY CANCEL
;;DG CHAMPUS OPT COPAY NEW^DG CHAMPUS OPT COPAY CANCEL
;;DG CHAMPUS INPT COPAY NEW^DG CHAMPUS INPT COPAY CANCEL
;;QUIT
;
;
MGRP ; Add new mailgroups
D BMES^XPDUTL(" ")
D BMES^XPDUTL(">>> Adding new mailgroups... (Be sure to add members!)")
;
S X="XMBGRP" X ^%ZOSF("TEST") E D BMES^XPDUTL(" >> Need MailMan v7.1 to add new mailgroups!") G MGRPQ
;
N IBUSER,IBD,IBNAME,IBJ,IBJJ
;
F IBJ=1:1:3 D
.S IBNAME=$P($T(@("GRP"_IBJ)+1),";",3) Q:IBNAME=""
.S IBUSER(DUZ)=""
.F IBJJ=2:1 S X=$P($T(@("GRP"_IBJ)+IBJJ),";",3) Q:X=""!(X="QUIT") S IBDESC(IBJJ-1)=X
.D BMES^XPDUTL(" >> Adding the group '"_IBNAME_"' ...")
.S X=$$MG^XMBGRP(IBNAME,0,DUZ,0,.IBUSER,.IBDESC,1)
;
MGRPQ Q
;
;
GRP1 ; Add mailgroup 1
;;IB CHAMP RX REJ
;;This mailgroup is used to report billing transactions rejected
;;from the CHAMPUS fiscal intermediary.
;;QUIT
;
GRP2 ; Add mailgroup 2
;;IB CHAMP RX REV
;;This mailgroup is used to report cancellation transactions rejected
;;from the CHAMPUS fiscal intermediary.
;;QUIT
;
GRP3 ; Add mailgroup 3
;;IB CHAMP RX START
;;This is used to report when the CHAMPUS billing engines have
;;been started. It also reports when AWP updates are received.
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYPPOST 4643 printed Nov 22, 2024@17:46:31 Page 2
IBYPPOST ; ALB/TMP - IB*2*52 POST-INIT ; 22-JAN-96
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
+2 ;
POST ;
+1 ; output generator post init
DO OGEN
+2 ; charge master post init
DO START^IBYPPC
+3 ; add action types to file #350.1
DO ACTTYP
+4 ; add new mailgroups
DO MGRP
+5 QUIT
+6 ;
+7 ;
OGEN ;Set up check points for post-init
+1 NEW %,Z
+2 SET %=$$NEWCP^XPDUTL("U399","U399^IBYPPOST")
+3 SET %=$$NEWCP^XPDUTL("U353","U353^IBYPPOST")
+4 QUIT
+5 ;
U399 NEW DONE,S1,Z,Z1,CT,%
+1 SET DONE="Step Complete."
SET CT=0
+2 SET S1=+$$PARCP^XPDUTL("U399")
+3 DO BMES^XPDUTL("Updating Bill/Claims file")
+4 FOR
SET S1=$ORDER(^DGCR(399,S1))
if 'S1
QUIT
SET Z=$GET(^DGCR(399,S1,0))
SET Z1=$PIECE(Z,U,11)
Begin DoDot:1
+5 SET CT=CT+1
+6 IF $PIECE(Z,U,13)<2!$PIECE(Z,U,13)>4!($PIECE(Z,U,21)'="")!$SELECT(Z1="":1,1:"pi"'[Z1)
if '(CT#200)
SET %=$$UPCP^XPDUTL("U399",S1)
QUIT
+7 SET Z1=$SELECT(Z1="p":"A",Z1="i":"P",1:"")
if Z1'=""
SET $PIECE(^(0),U,21)=Z1
if '(CT#200)
SET %=$$UPCP^XPDUTL("U399",S1)
End DoDot:1
+8 DO MES^XPDUTL(DONE)
+9 QUIT
+10 ;
U353 NEW DONE,Z
+1 SET DONE="Step Complete."
+2 DO BMES^XPDUTL("Updating Bill Form Type file")
+3 FOR Z=2,3
IF $GET(^IBE(353,Z,2))=""
SET ^IBE(353,Z,2)="399^P^66^1"
SET ^("PRE")="D ENTPRE^IBCFP1"
SET ^("POST")="D ENTPOST^IBCFP1"
SET ^("EXT")="D QB1^IBCFP1"
SET ^("FPRE")="D FORMPRE^IBCFP1"
SET ^("FPOST")="D FORMPOST^IBCFP1"
+4 SET Z=0
FOR
SET Z=$ORDER(^IBE(353,Z))
if 'Z
QUIT
IF $PIECE($GET(^(Z,2)),U,2)=""
SET $PIECE(^IBE(353,Z,2),U,2)="P"
+5 IF $PIECE($GET(^IBE(353,2,2)),U,6)=""
SET $PIECE(^IBE(353,2,2),U,6)="NATIONAL HCFA-1500"
SET $PIECE(^IBE(353,3,2),U,6)="NATIONAL UB-92"
+6 DO MES^XPDUTL(DONE)
+7 QUIT
+8 ;
+9 ;
ACTTYP ; Add Action Types
+1 DO BMES^XPDUTL(" ")
+2 DO BMES^XPDUTL(">>> Adding new IB Action Types into file #350.1...")
+3 ;
+4 ; - get IBAR
+5 SET IBAR=$ORDER(^PRCA(430.2,"B","CHAMPUS PATIENT",0))
+6 IF 'IBAR
DO BMES^XPDUTL(" >> Can't add action types! Install PRCA*4.5*48 first!")
GOTO ACTTYPQ
+7 ;
+8 ; - get rx serv
+9 SET IBSERV=$PIECE($GET(^IBE(350.1,1,0)),"^",4)
+10 IF '$$SERV^IBARX1(IBSERV)
DO BMES^XPDUTL(" >> Please check entry #1 in file #350.1 - the service should be Pharmacy.")
GOTO ACTTYPQ
+11 ;
+12 ; - add action types
+13 DO NEWAT
+14 ;
+15 ; - point them to the correct action types
+16 DO ATAT
+17 ;
ACTTYPQ KILL IBAR,IBSERV
+1 QUIT
+2 ;
+3 ;
NEWAT ; Add new IB Action Types into file #350.1
+1 FOR IBI=1:1
SET IBCR=$PIECE($TEXT(NAT+IBI),";;",2)
if IBCR="QUIT"
QUIT
Begin DoDot:1
+2 SET X=$PIECE(IBCR,"^")
+3 SET $PIECE(IBCR,"^",3,4)=IBAR_"^"_IBSERV
+4 IF $ORDER(^IBE(350.1,"B",X,0))
DO BMES^XPDUTL(" >> '"_X_"' is already on file...")
QUIT
+5 KILL DD,DO
SET DIC="^IBE(350.1,"
SET DIC(0)=""
DO FILE^DICN
if Y<0
QUIT
+6 SET ^(0)=^IBE(350.1,+Y,0)_"^"_$PIECE(IBCR,"^",2,11)
SET DIK=DIC
SET DA=+Y
DO IX1^DIK
+7 DO BMES^XPDUTL(" >> '"_$PIECE(IBCR,"^")_"' has been filed...")
End DoDot:1
+8 KILL DA,DIC,DIE,DR,IBI,IBCR,X,Y
+9 QUIT
+10 ;
NAT ; Action Types to add into file #350.1
+1 ;;DG CHAMPUS RX COPAY NEW^CUS RX^^^1^^^CHAMPUS RX COPAY^^^7
+2 ;;DG CHAMPUS OPT COPAY NEW^CUS OPT^^^1^^^CHAMPUS OPT COPAY^^^7
+3 ;;DG CHAMPUS INPT COPAY NEW^CUS INPT^^^1^^^CHAMPUS INPT COPAY^^^7
+4 ;;DG CHAMPUS RX COPAY CANCEL^CAN CRX^^^2
+5 ;;DG CHAMPUS OPT COPAY CANCEL^CAN COPT^^^2
+6 ;;DG CHAMPUS INPT COPAY CANCEL^CAN CINP^^^2
+7 ;;QUIT
+8 ;
+9 ;
ATAT ; Resolve pointers to file #350.1 from file #350.1
+1 FOR IBI=1:1
SET IBX=$PIECE($TEXT(ACT+IBI),";;",2,99)
if IBX="QUIT"
QUIT
Begin DoDot:1
+2 SET IBNEW=$ORDER(^IBE(350.1,"B",$PIECE(IBX,"^"),0))
+3 SET IBCAN=$ORDER(^IBE(350.1,"B",$PIECE(IBX,"^",2),0))
+4 FOR IBJ=IBNEW,IBCAN
Begin DoDot:2
+5 SET DIE="^IBE(350.1,"
SET DA=IBJ
+6 SET DR=".06////"_IBCAN_";.09////"_IBNEW
+7 DO ^DIE
KILL DA,DR,DIE
End DoDot:2
End DoDot:1
+8 ;
+9 KILL IBI,IBX,IBNEW,IBCAN,IBJ
+10 QUIT
+11 ;
+12 ;
ACT ;New Action (#350.1)^Cancel Action (#350.1)
+1 ;;DG CHAMPUS RX COPAY NEW^DG CHAMPUS RX COPAY CANCEL
+2 ;;DG CHAMPUS OPT COPAY NEW^DG CHAMPUS OPT COPAY CANCEL
+3 ;;DG CHAMPUS INPT COPAY NEW^DG CHAMPUS INPT COPAY CANCEL
+4 ;;QUIT
+5 ;
+6 ;
MGRP ; Add new mailgroups
+1 DO BMES^XPDUTL(" ")
+2 DO BMES^XPDUTL(">>> Adding new mailgroups... (Be sure to add members!)")
+3 ;
+4 SET X="XMBGRP"
XECUTE ^%ZOSF("TEST")
IF '$TEST
DO BMES^XPDUTL(" >> Need MailMan v7.1 to add new mailgroups!")
GOTO MGRPQ
+5 ;
+6 NEW IBUSER,IBD,IBNAME,IBJ,IBJJ
+7 ;
+8 FOR IBJ=1:1:3
Begin DoDot:1
+9 SET IBNAME=$PIECE($TEXT(@("GRP"_IBJ)+1),";",3)
if IBNAME=""
QUIT
+10 SET IBUSER(DUZ)=""
+11 FOR IBJJ=2:1
SET X=$PIECE($TEXT(@("GRP"_IBJ)+IBJJ),";",3)
if X=""!(X="QUIT")
QUIT
SET IBDESC(IBJJ-1)=X
+12 DO BMES^XPDUTL(" >> Adding the group '"_IBNAME_"' ...")
+13 SET X=$$MG^XMBGRP(IBNAME,0,DUZ,0,.IBUSER,.IBDESC,1)
End DoDot:1
+14 ;
MGRPQ QUIT
+1 ;
+2 ;
GRP1 ; Add mailgroup 1
+1 ;;IB CHAMP RX REJ
+2 ;;This mailgroup is used to report billing transactions rejected
+3 ;;from the CHAMPUS fiscal intermediary.
+4 ;;QUIT
+5 ;
GRP2 ; Add mailgroup 2
+1 ;;IB CHAMP RX REV
+2 ;;This mailgroup is used to report cancellation transactions rejected
+3 ;;from the CHAMPUS fiscal intermediary.
+4 ;;QUIT
+5 ;
GRP3 ; Add mailgroup 3
+1 ;;IB CHAMP RX START
+2 ;;This is used to report when the CHAMPUS billing engines have
+3 ;;been started. It also reports when AWP updates are received.
+4 ;;QUIT
