- 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 ---[H[J[2J[HPXVNITLY 1186 printed Feb 18, 2025@23:58:04 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
