IB20P88 ; ALB/TMP,RB - IB*2*88 POST-INIT ; 22-DEC-97
;;2.0; INTEGRATED BILLING ;**88**; 21-MAR-94
;
POST ;
N CT,DA,DIE,DR,NODE,Z,Z0,Z1
D BMES^XPDUTL("Restoring PRINTED IB bills to ENTERED/NOT REVIEWED")
S (CT,DA)=0
F S DA=$O(^PRCA(430,"AC",27,DA)) Q:+DA=0 I $P($G(^DGCR(399,DA,0)),U,13)=4 S DIE=399,DR=".13////1" D ^DIE S CT=CT+1
D BMES^XPDUTL(CT_" IB bill(s) changed from PRINTED status to ENTERED/NOT REVIEWED")
D BMES^XPDUTL(" ")
S (CT,Z)=0
D BMES^XPDUTL("Correcting Bill Type cross reference")
F S Z=$O(^IBA(364.7,"ATYPE",Z)) Q:'Z S Z0="" D
.F S Z0=$O(^IBA(364.7,"ATYPE",Z,Z0)) Q:Z0="" S Z1=0 F S Z1=$O(^IBA(364.7,"ATYPE",Z,Z0,Z1)) Q:'Z1 S NODE=$G(^IBA(364.7,Z1,0)) D
..I $P(NODE,U,6)'=Z0!($P(NODE,U,5)'="") K ^IBA(364.7,"ATYPE",Z,Z0,Z1) S CT=CT+1
D BMES^XPDUTL(CT_" Erroneous entries deleted")
D BMES^XPDUTL(" ")
S (CT,Z)=0
D BMES^XPDUTL("Correcting Insurance cross reference")
F S Z=$O(^IBA(364.7,"AINS",Z)) Q:'Z S Z0="" D
.F S Z0=$O(^IBA(364.7,"AINS",Z,Z0)) Q:Z0="" S Z1=0 F S Z1=$O(^IBA(364.7,"AINS",Z,Z0,Z1)) Q:'Z1 S NODE=$G(^IBA(364.7,Z1,0)) D
..I $P(NODE,U,5)'=Z0!($P(NODE,U,6)'="") K ^IBA(364.7,"AINS",Z,Z0,Z1) S CT=CT+1
D BMES^XPDUTL(CT_" Erroneous entries deleted")
D BMES^XPDUTL(" ")
D BMES^XPDUTL("Post install steps are complete")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P88 1318 printed Nov 22, 2024@17:15:10 Page 2
IB20P88 ; ALB/TMP,RB - IB*2*88 POST-INIT ; 22-DEC-97
+1 ;;2.0; INTEGRATED BILLING ;**88**; 21-MAR-94
+2 ;
POST ;
+1 NEW CT,DA,DIE,DR,NODE,Z,Z0,Z1
+2 DO BMES^XPDUTL("Restoring PRINTED IB bills to ENTERED/NOT REVIEWED")
+3 SET (CT,DA)=0
+4 FOR
SET DA=$ORDER(^PRCA(430,"AC",27,DA))
if +DA=0
QUIT
IF $PIECE($GET(^DGCR(399,DA,0)),U,13)=4
SET DIE=399
SET DR=".13////1"
DO ^DIE
SET CT=CT+1
+5 DO BMES^XPDUTL(CT_" IB bill(s) changed from PRINTED status to ENTERED/NOT REVIEWED")
+6 DO BMES^XPDUTL(" ")
+7 SET (CT,Z)=0
+8 DO BMES^XPDUTL("Correcting Bill Type cross reference")
+9 FOR
SET Z=$ORDER(^IBA(364.7,"ATYPE",Z))
if 'Z
QUIT
SET Z0=""
Begin DoDot:1
+10 FOR
SET Z0=$ORDER(^IBA(364.7,"ATYPE",Z,Z0))
if Z0=""
QUIT
SET Z1=0
FOR
SET Z1=$ORDER(^IBA(364.7,"ATYPE",Z,Z0,Z1))
if 'Z1
QUIT
SET NODE=$GET(^IBA(364.7,Z1,0))
Begin DoDot:2
+11 IF $PIECE(NODE,U,6)'=Z0!($PIECE(NODE,U,5)'="")
KILL ^IBA(364.7,"ATYPE",Z,Z0,Z1)
SET CT=CT+1
End DoDot:2
End DoDot:1
+12 DO BMES^XPDUTL(CT_" Erroneous entries deleted")
+13 DO BMES^XPDUTL(" ")
+14 SET (CT,Z)=0
+15 DO BMES^XPDUTL("Correcting Insurance cross reference")
+16 FOR
SET Z=$ORDER(^IBA(364.7,"AINS",Z))
if 'Z
QUIT
SET Z0=""
Begin DoDot:1
+17 FOR
SET Z0=$ORDER(^IBA(364.7,"AINS",Z,Z0))
if Z0=""
QUIT
SET Z1=0
FOR
SET Z1=$ORDER(^IBA(364.7,"AINS",Z,Z0,Z1))
if 'Z1
QUIT
SET NODE=$GET(^IBA(364.7,Z1,0))
Begin DoDot:2
+18 IF $PIECE(NODE,U,5)'=Z0!($PIECE(NODE,U,6)'="")
KILL ^IBA(364.7,"AINS",Z,Z0,Z1)
SET CT=CT+1
End DoDot:2
End DoDot:1
+19 DO BMES^XPDUTL(CT_" Erroneous entries deleted")
+20 DO BMES^XPDUTL(" ")
+21 DO BMES^XPDUTL("Post install steps are complete")
+22 ;
+23 QUIT
