ALPBOP.m

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 ---ALPBOP   1512     printed  Apr 09, 2024@20:46:21                                                                                                                                                                                                      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