PSB381P ;MNT/BJR - Move Units Given field to Units Ordered ;
;;3.0;BAR CODE MED ADMIN;**81**;Mar 2004;Build 6
;;Per VA Directive 6402, this routine should not be modified.
;
Q
EN ;This routine will delete any "AADT" indexes that do not have a corresponding 0 node for the last 60 days for patch PSB*3*81
;This routine will also delete any "AINFUSING" indexes for completed bags.
D MES^XPDUTL("")
D MES^XPDUTL("*** PSB*3*81 Post Install Running ***")
D MES^XPDUTL("")
N PSBDFN,PSBBEGIN,PSBSTRT,PSBIEN
D NOW^%DTC S PSBBEGIN=$$FMADD^XLFDT(X,-60)
S PSBDFN=0 F S PSBDFN=$O(^PSB(53.79,"AADT",PSBDFN)) Q:'PSBDFN D
.S PSBSTRT=PSBBEGIN F S PSBSTRT=$O(^PSB(53.79,"AADT",PSBDFN,PSBSTRT)) Q:'PSBSTRT D
..S PSBIEN=0 F S PSBIEN=$O(^PSB(53.79,"AADT",PSBDFN,PSBSTRT,PSBIEN)) Q:'PSBIEN D
...I '$D(^PSB(53.79,PSBIEN,0)) K ^PSB(53.79,"AADT",PSBDFN,PSBSTRT,PSBIEN) D MES^XPDUTL("AADT Index Deleted for record "_PSBIEN)
S PSBDFN=0 F S PSBDFN=$O(^PSB(53.79,"AINFUSING",PSBDFN)) Q:'PSBDFN D
.S PSBSTRT=0 F S PSBSTRT=$O(^PSB(53.79,"AINFUSING",PSBDFN,PSBSTRT)) Q:'PSBSTRT D
..S PSBIEN=0 F S PSBIEN=$O(^PSB(53.79,"AINFUSING",PSBDFN,PSBSTRT,PSBIEN)) Q:'PSBIEN D
...I $$GET1^DIQ(53.79,PSBIEN_",",.09,"I")="C" K ^PSB(53.79,"AINFUSING",PSBDFN,PSBSTRT,PSBIEN) D MES^XPDUTL("AINFUSING Index Deleted for record "_PSBIEN)
D MES^XPDUTL("")
D MES^XPDUTL("*** PSB*3*81 Post Install Completed ***")
D MES^XPDUTL("")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSB381P 1441 printed Dec 13, 2024@01:39:43 Page 2
PSB381P ;MNT/BJR - Move Units Given field to Units Ordered ;
+1 ;;3.0;BAR CODE MED ADMIN;**81**;Mar 2004;Build 6
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
EN ;This routine will delete any "AADT" indexes that do not have a corresponding 0 node for the last 60 days for patch PSB*3*81
+1 ;This routine will also delete any "AINFUSING" indexes for completed bags.
+2 DO MES^XPDUTL("")
+3 DO MES^XPDUTL("*** PSB*3*81 Post Install Running ***")
+4 DO MES^XPDUTL("")
+5 NEW PSBDFN,PSBBEGIN,PSBSTRT,PSBIEN
+6 DO NOW^%DTC
SET PSBBEGIN=$$FMADD^XLFDT(X,-60)
+7 SET PSBDFN=0
FOR
SET PSBDFN=$ORDER(^PSB(53.79,"AADT",PSBDFN))
if 'PSBDFN
QUIT
Begin DoDot:1
+8 SET PSBSTRT=PSBBEGIN
FOR
SET PSBSTRT=$ORDER(^PSB(53.79,"AADT",PSBDFN,PSBSTRT))
if 'PSBSTRT
QUIT
Begin DoDot:2
+9 SET PSBIEN=0
FOR
SET PSBIEN=$ORDER(^PSB(53.79,"AADT",PSBDFN,PSBSTRT,PSBIEN))
if 'PSBIEN
QUIT
Begin DoDot:3
+10 IF '$DATA(^PSB(53.79,PSBIEN,0))
KILL ^PSB(53.79,"AADT",PSBDFN,PSBSTRT,PSBIEN)
DO MES^XPDUTL("AADT Index Deleted for record "_PSBIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+11 SET PSBDFN=0
FOR
SET PSBDFN=$ORDER(^PSB(53.79,"AINFUSING",PSBDFN))
if 'PSBDFN
QUIT
Begin DoDot:1
+12 SET PSBSTRT=0
FOR
SET PSBSTRT=$ORDER(^PSB(53.79,"AINFUSING",PSBDFN,PSBSTRT))
if 'PSBSTRT
QUIT
Begin DoDot:2
+13 SET PSBIEN=0
FOR
SET PSBIEN=$ORDER(^PSB(53.79,"AINFUSING",PSBDFN,PSBSTRT,PSBIEN))
if 'PSBIEN
QUIT
Begin DoDot:3
+14 IF $$GET1^DIQ(53.79,PSBIEN_",",.09,"I")="C"
KILL ^PSB(53.79,"AINFUSING",PSBDFN,PSBSTRT,PSBIEN)
DO MES^XPDUTL("AINFUSING Index Deleted for record "_PSBIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+15 DO MES^XPDUTL("")
+16 DO MES^XPDUTL("*** PSB*3*81 Post Install Completed ***")
+17 DO MES^XPDUTL("")
+18 QUIT
