ALPBOP ;OIFO-DALLAS/SED/KC/FOXK BCMA-BCBU PURGE OLD ORDERS ;5/2/2002
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
;
ST ;Start here. Purge Order information based of stop date first
;Get the parameter setting for number of days to hold patient
;orders. Default is 7 days
D NOW^%DTC
S X1=X
S X2="-"_$$DEFOR^ALPBUTL3()
D C^%DTC S ALPPUR=X K X1,X2
S ALPPUR=X
D WAIT^DICD
S ALPDFN=0
F S ALPDFN=$O(^ALPB(53.7,ALPDFN)) Q:+ALPDFN'>0 D
. S ALPBIEN=0
. F S ALPBIEN=$O(^ALPB(53.7,ALPDFN,2,ALPBIEN)) Q:+ALPBIEN'>0 D
. . ;First look for Stop Date
. . S ALPBDATE=+$P($G(^ALPB(53.7,ALPDFN,2,ALPBIEN,1)),U,2)
. . ;If stop date is not there then use last updated date
. . S:+ALPBDATE'>0 ALPBDATE=+$P(^ALPB(53.7,ALPDFN,2,ALPBIEN,0),U,4)
. . Q:ALPBDATE>ALPPUR
. . K DIK,DA
. . S DA(1)=ALPDFN,DA=ALPBIEN
. . S DIK="^ALPB(53.7,"_DA(1)_",2," D ^DIK
. ;Now check to see if I need to remove the patient record
. D NOW^%DTC
. S X1=X
. ;Get the parameter setting for number of days to hold patient record
. ;Default is 30 days with no order information
. S X2="-"_$$DEFPR^ALPBUTL3()
. D C^%DTC S ALPPUR=X K X1,X2
. S ALPPUR=X
. S ALPBDATE=+$P(^ALPB(53.7,ALPDFN,0),U,8)
. ;Quit if record had been updated within time frame
. Q:ALPBDATE>ALPPUR
. I '$D(^ALPB(53.7,ALPDFN,2)) D RPAT Q
. I +$O(^ALPB(53.7,ALPDFN,2,0))'>0 D RPAT
STOP K ALPBIEN,ALPDFN,DA,ALPBDATE,ALPPUR,DR,DIE,X,DIK,X1,X2
Q
RPAT ;Remove patient
K DIK
S DA=ALPDFN
S DIK="^ALPB(53.7," D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBOP 1512 printed Oct 16, 2024@17:40:19 Page 2
ALPBOP ;OIFO-DALLAS/SED/KC/FOXK BCMA-BCBU PURGE OLD ORDERS ;5/2/2002
+1 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
+2 ;
ST ;Start here. Purge Order information based of stop date first
+1 ;Get the parameter setting for number of days to hold patient
+2 ;orders. Default is 7 days
+3 DO NOW^%DTC
+4 SET X1=X
+5 SET X2="-"_$$DEFOR^ALPBUTL3()
+6 DO C^%DTC
SET ALPPUR=X
KILL X1,X2
+7 SET ALPPUR=X
+8 DO WAIT^DICD
+9 SET ALPDFN=0
+10 FOR
SET ALPDFN=$ORDER(^ALPB(53.7,ALPDFN))
if +ALPDFN'>0
QUIT
Begin DoDot:1
+11 SET ALPBIEN=0
+12 FOR
SET ALPBIEN=$ORDER(^ALPB(53.7,ALPDFN,2,ALPBIEN))
if +ALPBIEN'>0
QUIT
Begin DoDot:2
+13 ;First look for Stop Date
+14 SET ALPBDATE=+$PIECE($GET(^ALPB(53.7,ALPDFN,2,ALPBIEN,1)),U,2)
+15 ;If stop date is not there then use last updated date
+16 if +ALPBDATE'>0
SET ALPBDATE=+$PIECE(^ALPB(53.7,ALPDFN,2,ALPBIEN,0),U,4)
+17 if ALPBDATE>ALPPUR
QUIT
+18 KILL DIK,DA
+19 SET DA(1)=ALPDFN
SET DA=ALPBIEN
+20 SET DIK="^ALPB(53.7,"_DA(1)_",2,"
DO ^DIK
End DoDot:2
+21 ;Now check to see if I need to remove the patient record
+22 DO NOW^%DTC
+23 SET X1=X
+24 ;Get the parameter setting for number of days to hold patient record
+25 ;Default is 30 days with no order information
+26 SET X2="-"_$$DEFPR^ALPBUTL3()
+27 DO C^%DTC
SET ALPPUR=X
KILL X1,X2
+28 SET ALPPUR=X
+29 SET ALPBDATE=+$PIECE(^ALPB(53.7,ALPDFN,0),U,8)
+30 ;Quit if record had been updated within time frame
+31 if ALPBDATE>ALPPUR
QUIT
+32 IF '$DATA(^ALPB(53.7,ALPDFN,2))
DO RPAT
QUIT
+33 IF +$ORDER(^ALPB(53.7,ALPDFN,2,0))'>0
DO RPAT
End DoDot:1
STOP KILL ALPBIEN,ALPDFN,DA,ALPBDATE,ALPPUR,DR,DIE,X,DIK,X1,X2
+1 QUIT
RPAT ;Remove patient
+1 KILL DIK
+2 SET DA=ALPDFN
+3 SET DIK="^ALPB(53.7,"
DO ^DIK
+4 QUIT
