PXVNITLY.m

PXVNITLY ;BIR/CML3,ADM - IMMUNIZATION NIGHTLY TASK ;20 MAY 2015

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**210**;Aug 12, 1996;Build 21

 ;

EXP ; set STATUS of expired lots to INACTIVE

 ; - must be run nightly immediately after midnight

 ; - loops through entire list every time to avoid missing dates in case

 ;   the process fails to run daily for whatever reason

 ;

 N DA,DIE,DR,PXVDT,X

 D DT^DICRW

 S PXVDT=0

 F  S PXVDT=$O(^AUTTIML("AE",PXVDT)) Q:'PXVDT  I DT>PXVDT D

 .S DA=0 F  S DA=$O(^AUTTIML("AE",PXVDT,DA)) Q:'DA  D

 ..S X=$P($G(^AUTTIML(DA,0)),"^",3)

 ..I 'X S DIE="^AUTTIML(",DR=".03////1" D ^DIE

 Q

LXC ; check for lot number entries that have expired

 ; need to find way to NOT loop through entire list every time,

 ; to stop at orders already checked

 ; PXVDT - date (no time), seeded with today's date

 ; "AE" x-ref - ^AUTTIML("AE",lot number expiration date, lot number IEN)

 ;

 ;

 ;N PXVDT,%,$H,DA,DIE,DILOCKTM,DISYS,X,Y

 ;D DT^DICRW S PXVDT=DT

 ;F  S PXVDT=$O(^AUTTIML("AE",PXVDT),-1) Q:'PXVDT  D  ;

 ;.S DA=0 F  S DA=$O(^AUTTIML("AE",PXVDT,DA)) Q:'DA  D  ;

 ;..S X=$P($G(^AUTTIML(DA,0)),"^",3)

 ;..I 'X S DIE="^AUTTIML(",DR=".O3///2" D ^DIE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXVNITLY   1186     printed  Apr 09, 2024@21:32:02                                                                                                                                                                                                    Page 2

PXVNITLY  ;BIR/CML3,ADM - IMMUNIZATION NIGHTLY TASK ;20 MAY 2015

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**210**;Aug 12, 1996;Build 21

 +2       ;

EXP       ; set STATUS of expired lots to INACTIVE

 +1       ; - must be run nightly immediately after midnight

 +2       ; - loops through entire list every time to avoid missing dates in case

 +3       ;   the process fails to run daily for whatever reason

 +4       ;

 +5        NEW DA,DIE,DR,PXVDT,X

 +6        DO DT^DICRW

 +7        SET PXVDT=0

 +8        FOR 

               SET PXVDT=$ORDER(^AUTTIML("AE",PXVDT))

               if 'PXVDT

                   QUIT 

               IF DT>PXVDT

                   Begin DoDot:1

 +9                    SET DA=0

                       FOR 

                           SET DA=$ORDER(^AUTTIML("AE",PXVDT,DA))

                           if 'DA

                               QUIT 

                           Begin DoDot:2

 +10                           SET X=$PIECE($GET(^AUTTIML(DA,0)),"^",3)

 +11                           IF 'X

                                   SET DIE="^AUTTIML("

                                   SET DR=".03////1"

                                   DO ^DIE

                           End DoDot:2

                   End DoDot:1

 +12       QUIT 

LXC       ; check for lot number entries that have expired

 +1       ; need to find way to NOT loop through entire list every time,

 +2       ; to stop at orders already checked

 +3       ; PXVDT - date (no time), seeded with today's date

 +4       ; "AE" x-ref - ^AUTTIML("AE",lot number expiration date, lot number IEN)

 +5       ;

 +6       ;

 +7       ;N PXVDT,%,$H,DA,DIE,DILOCKTM,DISYS,X,Y

 +8       ;D DT^DICRW S PXVDT=DT

 +9       ;F  S PXVDT=$O(^AUTTIML("AE",PXVDT),-1) Q:'PXVDT  D  ;

 +10      ;.S DA=0 F  S DA=$O(^AUTTIML("AE",PXVDT,DA)) Q:'DA  D  ;

 +11      ;..S X=$P($G(^AUTTIML(DA,0)),"^",3)

 +12      ;..I 'X S DIE="^AUTTIML(",DR=".O3///2" D ^DIE

 +13       QUIT