PXVXR ;BIR/ADM - CROSS REFERENCE AND OTHER LOGIC ;Dec 20, 2022@13:24:02
;;1.0;PCE PATIENT CARE ENCOUNTER;**210,216,211,217,233**;Aug 12, 1996;Build 3
;
Q
EXP ; check for expiration date in the past
N PXVX,PXVDT,Y
S PXVDT=X I PXVDT<DT D Q
.D EN^DDIOL(">>> The date entered is a past date. <<<","","!!?4") S PXVX=$C(7) D EN^DDIOL(PXVX,"","!")
.K DIR S DIR("A")=" Are you sure you have entered the correct date",DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
.I $D(DTOUT)!$D(DUOUT)!'Y K X Q
.S X=PXVDT
Q
INUSE ; input check on LOT NUMBER field (#.01)
N PXV,PXVIM,PXVLN,PXVMAN,PXVX
I $D(^AUPNVIMM("LN",DA)) D Q:'$D(X)
.D EN^DDIOL("Lot Number already assigned and cannot be edited.","","!!?4")
.S PXVX=$C(7) D EN^DDIOL(PXVX,"","!") K X
COMB ; check on LOT NUMBER field (#.01) for uniqueness of Immunization Name, Lot Number and Manufacturer combination
S PXVLN=X
S PXV=$G(^AUTTIML(DA,0)),PXVMAN=$P(PXV,"^",2),PXVIM=$P(PXV,"^",4) I PXVMAN=""!(PXVIM="") Q
AUCHK N PXVINST,PXVSTN
S PXVSTN=$P($G(^AUTTIML(DA,0)),"^",10)
I PXVSTN="",$G(PXVFIEN) S PXVSTN=PXVFIEN
I PXVSTN'="" S PXVSTN="_#"_PXVSTN,PXVLN=PXVLN_PXVSTN
I $D(^AUTTIML("AC",PXVIM,PXVMAN,PXVLN)) D Q
.D EN^DDIOL("Immunization Name, Lot Number and Manufacturer combination must be unique.","","!!?4")
.S PXVX=$C(7) D EN^DDIOL(PXVX,"","!") K X
Q
COMB1 ; input check on MANUFACTURER field (#.02)
N PXV,PXVIM,PXVLN,PXVMAN,PXVX
S PXVMAN=X
S PXV=$G(^AUTTIML(DA,0)),PXVLN=$P(PXV,"^"),PXVIM=$P(PXV,"^",4) I PXVLN=""!(PXVIM="") Q
D AUCHK
Q
COMB2 ; input check on VACCINE field (#.04)
N PXV,PXVIM,PXVLN,PXVMAN,PXVX
S PXVIM=X
S PXV=$G(^AUTTIML(DA,0)),PXVLN=$P(PXV,"^"),PXVMAN=$P(PXV,"^",2) I PXVLN=""!(PXVMAN="") Q
D AUCHK
Q
;
ACT(PXLOT) ; screen immunization with active immunization lot number
;
; ZEXCEPT: DA,PXCEFIEN,PXCEVIEN,PXD,PXVISIEN
N PXDT,PXRSLT,PXVIEN,PXIMMIEN,PXVISIT,PXINST
;
S PXRSLT=0
;
; Get Immunization IEN
S PXVIEN=$S($D(DA):DA,$G(PXCEFIEN):PXCEFIEN,1:"")
S PXIMMIEN=$S(PXVIEN:$P(^AUPNVIMM(PXVIEN,0),U),$G(PXD)'="":$P(PXD,"^"),1:"")
I 'PXIMMIEN Q 0
;
; Only allow Lots for this Immunization
I '$D(^AUTTIML("C",PXIMMIEN,PXLOT)) Q 0
;
; Get Division of Visit
S PXVISIT=$S(PXVIEN:$P(^AUPNVIMM(PXVIEN,0),"^",3),$G(PXCEVIEN):PXCEVIEN,$G(PXVISIEN):PXVISIEN,1:"")
S PXINST=$$DIV1(PXVISIT)
;
; Only allow Lots that belong to this Division
I PXINST,'$$IMMSEL(PXLOT,PXINST) Q 0
;
; Check if Lot is active and not expired at the time of the Visit
S PXDT=""
I PXVIEN S PXDT=$P($G(^AUPNVIMM(PXVIEN,12)),U,1)
I 'PXDT,PXVISIT S PXDT=$P($G(^AUPNVSIT(PXVISIT,0)),U,1)
S PXRSLT=$$LOTSTAT(PXLOT,PXDT)
;
Q PXRSLT
;
LOTSTAT(PXLOT,PXDT) ; Check if lot is active and not expired
;
N PXEXPDT,PXNODE,PXSTAT,PXSTATDT,PXSTATIEN
;
I '$G(PXDT) S PXDT=$$NOW^XLFDT()
;
S PXNODE=$G(^AUTTIML(+$G(PXLOT),0))
I PXNODE="" Q 0
;
; Check if lot is expired
S PXEXPDT=$P(PXNODE,U,9)
I $P(PXDT,".",1)>$P(PXEXPDT,".",1) Q 0
;
; if lot is active now, let them select it regardless if it was inactive in the past
I $P(PXNODE,U,3)'>0 Q 1
;
; If it's inactive now, see if it was active on PXDT
S PXSTATIEN=""
I $D(^AUTTIML(PXLOT,1,"B",PXDT)) S PXSTATIEN=$O(^AUTTIML(PXLOT,1,"B",PXDT,0))
I 'PXSTATIEN D
. S PXSTATDT=$O(^AUTTIML(PXLOT,1,"B",PXDT),-1)
. I PXSTATDT S PXSTATIEN=$O(^AUTTIML(PXLOT,1,"B",PXSTATDT,0))
I PXSTATIEN S PXSTAT=$P($G(^AUTTIML(PXLOT,1,PXSTATIEN,0)),U,3)
I 'PXSTATIEN D
. I $D(^AUTTIML(PXLOT,1,"B")) S PXSTAT=0 Q
. S PXSTAT=$P(PXNODE,U,3)
I PXSTAT>0 Q 0
;
Q 1
;
IMMSEL(PXVLOT,PXVIN) ; is this lot # selectable for this facility
N PXVST
S PXVST=0
I $D(^AUTTIML("AF",PXVIN,PXVLOT))!($P(^AUTTIML(PXVLOT,0),"^",10)="") S PXVST=1
Q PXVST
;
LOT() ;
N PXVIMM,PXVLN
S PXVIMM=0 D Q PXVIMM
.S PXVLN=0 F S PXVLN=$O(^AUTTIML("C",Y,PXVLN)) Q:'PXVLN I $P(^AUTTIML(PXVLN,0),"^",12)>0 S PXVIMM=1 Q
Q
;
DIV1(PXVISIT) ; return division associated with the encounter
N PXVL
S (PXVIN,PXVL)=""
I PXVISIT D
.S PXVL=$P(^AUPNVSIT(PXVISIT,0),"^",22)
.I PXVL S PXVIN=$P(^SC(PXVL,0),"^",4)
.; if hospital location institution is null, set institution to LOC. OF ENCOUNTER in VISIT file
.; else set institution to Kernel default institution
.I 'PXVIN S PXVIN=$S($P(^AUPNVSIT(PXVISIT,0),"^",6):$P(^AUPNVSIT(PXVISIT,0),"^",6),$G(DUZ(2)):$G(DUZ(2)),1:$$KSP^XUPARAM("INST"))
Q PXVIN
;
HIST() ; check if historical encounter
N PXVIEN,PXVHIST,PXVSIT,PXVSRCE
S PXVHIST=0
S PXVIEN=$S($G(DA):DA,$G(PXKPIEN):PXKPIEN,$G(PXVNEWIM):PXVNEWIM,1:"") I 'PXVIEN Q PXVHIST
S PXVSRCE=$P($G(^AUPNVIMM(PXVIEN,13)),"^")
I PXVSRCE="",$G(PXKAFT("13")) S PXVSRCE=$P(PXKAFT("13"),"^")
I PXVSRCE S PXVHIST=$S(PXVSRCE=$O(^PXV(920.1,"H","00",0)):0,1:1) Q PXVHIST
S PXVSIT=$P(^AUPNVIMM(PXVIEN,0),"^",3)
I $P($G(^AUPNVSIT(PXVSIT,0)),"^",7)="E" S PXVHIST=1
Q PXVHIST
;
DECR ; set logic for AF x-ref in V IMMUNIZATION file
; decrement doses unused in IMMUNIZATION LOT file
; check if "low stock" message needs to be sent
;
N PXV,PXCURSTOCK,PXIMM,PXINST,PXLOT,PXOLDSTOCK,PXTHRESHOLD,PXVISIT,PXVIMM
;
S PXVIMM=+$G(DA)
S PXLOT=+$G(X)
;
D
. N DA,X
. ;
. I $$HIST Q
. ;
. S PXIMM=$P($G(^AUPNVIMM(PXVIMM,0)),U,1)
. I 'PXIMM Q
. S PXVISIT=$P($G(^AUPNVIMM(PXVIMM,0)),U,3)
. S PXINST=+$$DIV1(PXVISIT)
. ;
. L +^AUTTIML("C",PXIMM):$G(DILOCKTM,3)
. S PXOLDSTOCK=$$STOCKQTY(PXINST,PXIMM)
. S PXV=$P($G(^AUTTIML(PXLOT,0)),"^",12)
. I 'PXV D Q
. . L -^AUTTIML("C",PXIMM)
. S PXV=PXV-1
. S $P(^AUTTIML(PXLOT,0),"^",12)=PXV
. L -^AUTTIML("C",PXIMM)
. ;
. ; check if need to send low stock message
. I '$$GET^XPAR("DIV.`"_PXINST_"^SYS^PKG","PXV IMM INVENTORY ALERTS",1,"I") Q
. S PXTHRESHOLD=+$P(PXOLDSTOCK,U,2)
. S PXOLDSTOCK=$P(PXOLDSTOCK,U,1)
. S PXCURSTOCK=PXOLDSTOCK-1
. I PXOLDSTOCK>PXTHRESHOLD,PXCURSTOCK'>PXTHRESHOLD D SENDMSG(PXINST,PXIMM,PXCURSTOCK)
;
Q
;
INCR ; kill logic for AF x-ref in V IMMUNIZATION file
; increment doses unused in IMMUNIZATION LOT file
I $$HIST Q
N PXV
S PXV=$P($G(^AUTTIML(X,0)),"^",12) I PXV="" Q
S PXV=PXV+1,$P(^AUTTIML(X,0),"^",12)=PXV
Q
;
STOCKQTY(PXINST,PXIMM) ;
; Return the total active stock for this imm/div.
; Also, return the largest Low Supply Alert value (this will be used as
; the threshold to see if an alert should be sent).
;
N PXLOTNUM,PXNODE0,PXSTOCK,PXTHRESHOLD,PXX
S PXTHRESHOLD=0
S PXSTOCK=0
S PXLOTNUM=0
F S PXLOTNUM=$O(^AUTTIML("C",PXIMM,PXLOTNUM)) Q:'PXLOTNUM D
. S PXNODE0=$G(^AUTTIML(PXLOTNUM,0))
. I '$$LOTSTAT(PXLOTNUM) Q ;Quit if Inactive or expired
. I '$$IMMSEL(PXLOTNUM,PXINST) Q ;not linked to this div
. S PXSTOCK=PXSTOCK+$P(PXNODE0,U,12)
. S PXX=$P(PXNODE0,U,15)
. I PXX>PXTHRESHOLD S PXTHRESHOLD=PXX
Q PXSTOCK_U_PXTHRESHOLD
;
SENDMSG(PXINST,PXIMM,PXSTOCK) ; Send MailMan message that stock is low
N DIWF,DIWL,DIWR,PXBODY,PXIMMNAME,PXINSTNM,PXINSTR,PXMSG,PXTO,X
S PXIMMNAME=$P($G(^AUTTIMM(PXIMM,0)),"^",1)
S PXINSTNM=$P($$NS^XUAF4(PXINST),U,1)
S PXMSG="Low stock of "_$E(PXIMMNAME,1,25)_" for "_$E(PXINSTNM,1,20)
D EN^DDIOL(">> "_PXMSG_"! <<",,"!!,?2")
M PXTO=^XUSEC("PXV IMM INVENTORY MGR")
S PXTO("G.PXV IMM INVENTORY ALERTS")=""
S X="Low stock of "_PXIMMNAME_" for "_PXINSTNM_". There are "_PXSTOCK_" doses remaining."
K ^UTILITY($J,"W")
S DIWL=1
S DIWR=80
S DIWF="|"
D ^DIWP
M PXBODY=^UTILITY($J,"W",1)
K ^UTILITY($J,"W")
S PXINSTR("FROM")="PXV IMM INVENTORY MGR"
S PXINSTR("LATER")=$$NOW^XLFDT
D SENDMSG^XMXAPI(DUZ,PXMSG,"PXBODY",.PXTO,.PXINSTR)
Q
;
;
; Update Immunization Lot Effective Date/Time multiple
; Called from AH x-ref IMMUNIZATION LOT file
UPDSTAT(PXIEN,PXOLDSTATUS,PXNEWSTATUS,PXDT,PXUSER) ;
;
N PXIENSUB,PXX
;
I '$G(PXIEN) Q
I '$D(^AUTTIML(PXIEN,0)) Q
S PXOLDSTATUS=$G(PXOLDSTATUS)
S PXNEWSTATUS=$G(PXNEWSTATUS)
I '$G(PXDT) S PXDT=$$NOW^XLFDT()
I '$G(PXUSER) S PXUSER=DUZ
;
I PXOLDSTATUS=PXNEWSTATUS,$O(^AUTTIML(PXIEN,1,0)) Q
;
F Q:'$D(^AUTTIML(PXIEN,1,"B",PXDT)) D
. S PXDT=$$FMADD^XLFDT(PXDT,,,,1)
;
S PXIENSUB=$O(^AUTTIML(PXIEN,1,"A"),-1)+1
F Q:'$D(^AUTTIML(PXIEN,1,PXIENSUB)) D
. S PXIENSUB=PXIENSUB+1
;
; this this is called from a x-ref, trying to avoid making
; a new FileMan call, and instead using direct sets.
S ^AUTTIML(PXIEN,1,PXIENSUB,0)=PXDT_U_PXUSER_U_PXNEWSTATUS
S ^AUTTIML(PXIEN,1,"B",PXDT,PXIENSUB)=""
I $G(^AUTTIML(PXIEN,1,0))="" S ^AUTTIML(PXIEN,1,0)="^9999999.411DA^0^0"
S PXX=$P(^AUTTIML(PXIEN,1,0),4)+1
S $P(^AUTTIML(PXIEN,1,0),U,3,4)=PXIENSUB_U_PXX
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVXR 8610 printed May 14, 2023@14:52:59 Page 2
PXVXR ;BIR/ADM - CROSS REFERENCE AND OTHER LOGIC ;Dec 20, 2022@13:24:02
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**210,216,211,217,233**;Aug 12, 1996;Build 3
+2 ;
+3 QUIT
EXP ; check for expiration date in the past
+1 NEW PXVX,PXVDT,Y
+2 SET PXVDT=X
IF PXVDT<DT
Begin DoDot:1
+3 DO EN^DDIOL(">>> The date entered is a past date. <<<","","!!?4")
SET PXVX=$CHAR(7)
DO EN^DDIOL(PXVX,"","!")
+4 KILL DIR
SET DIR("A")=" Are you sure you have entered the correct date"
SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
KILL X
QUIT
+6 SET X=PXVDT
End DoDot:1
QUIT
+7 QUIT
INUSE ; input check on LOT NUMBER field (#.01)
+1 NEW PXV,PXVIM,PXVLN,PXVMAN,PXVX
+2 IF $DATA(^AUPNVIMM("LN",DA))
Begin DoDot:1
+3 DO EN^DDIOL("Lot Number already assigned and cannot be edited.","","!!?4")
+4 SET PXVX=$CHAR(7)
DO EN^DDIOL(PXVX,"","!")
KILL X
End DoDot:1
if '$DATA(X)
QUIT
COMB ; check on LOT NUMBER field (#.01) for uniqueness of Immunization Name, Lot Number and Manufacturer combination
+1 SET PXVLN=X
+2 SET PXV=$GET(^AUTTIML(DA,0))
SET PXVMAN=$PIECE(PXV,"^",2)
SET PXVIM=$PIECE(PXV,"^",4)
IF PXVMAN=""!(PXVIM="")
QUIT
AUCHK NEW PXVINST,PXVSTN
+1 SET PXVSTN=$PIECE($GET(^AUTTIML(DA,0)),"^",10)
+2 IF PXVSTN=""
IF $GET(PXVFIEN)
SET PXVSTN=PXVFIEN
+3 IF PXVSTN'=""
SET PXVSTN="_#"_PXVSTN
SET PXVLN=PXVLN_PXVSTN
+4 IF $DATA(^AUTTIML("AC",PXVIM,PXVMAN,PXVLN))
Begin DoDot:1
+5 DO EN^DDIOL("Immunization Name, Lot Number and Manufacturer combination must be unique.","","!!?4")
+6 SET PXVX=$CHAR(7)
DO EN^DDIOL(PXVX,"","!")
KILL X
End DoDot:1
QUIT
+7 QUIT
COMB1 ; input check on MANUFACTURER field (#.02)
+1 NEW PXV,PXVIM,PXVLN,PXVMAN,PXVX
+2 SET PXVMAN=X
+3 SET PXV=$GET(^AUTTIML(DA,0))
SET PXVLN=$PIECE(PXV,"^")
SET PXVIM=$PIECE(PXV,"^",4)
IF PXVLN=""!(PXVIM="")
QUIT
+4 DO AUCHK
+5 QUIT
COMB2 ; input check on VACCINE field (#.04)
+1 NEW PXV,PXVIM,PXVLN,PXVMAN,PXVX
+2 SET PXVIM=X
+3 SET PXV=$GET(^AUTTIML(DA,0))
SET PXVLN=$PIECE(PXV,"^")
SET PXVMAN=$PIECE(PXV,"^",2)
IF PXVLN=""!(PXVMAN="")
QUIT
+4 DO AUCHK
+5 QUIT
+6 ;
ACT(PXLOT) ; screen immunization with active immunization lot number
+1 ;
+2 ; ZEXCEPT: DA,PXCEFIEN,PXCEVIEN,PXD,PXVISIEN
+3 NEW PXDT,PXRSLT,PXVIEN,PXIMMIEN,PXVISIT,PXINST
+4 ;
+5 SET PXRSLT=0
+6 ;
+7 ; Get Immunization IEN
+8 SET PXVIEN=$SELECT($DATA(DA):DA,$GET(PXCEFIEN):PXCEFIEN,1:"")
+9 SET PXIMMIEN=$SELECT(PXVIEN:$PIECE(^AUPNVIMM(PXVIEN,0),U),$GET(PXD)'="":$PIECE(PXD,"^"),1:"")
+10 IF 'PXIMMIEN
QUIT 0
+11 ;
+12 ; Only allow Lots for this Immunization
+13 IF '$DATA(^AUTTIML("C",PXIMMIEN,PXLOT))
QUIT 0
+14 ;
+15 ; Get Division of Visit
+16 SET PXVISIT=$SELECT(PXVIEN:$PIECE(^AUPNVIMM(PXVIEN,0),"^",3),$GET(PXCEVIEN):PXCEVIEN,$GET(PXVISIEN):PXVISIEN,1:"")
+17 SET PXINST=$$DIV1(PXVISIT)
+18 ;
+19 ; Only allow Lots that belong to this Division
+20 IF PXINST
IF '$$IMMSEL(PXLOT,PXINST)
QUIT 0
+21 ;
+22 ; Check if Lot is active and not expired at the time of the Visit
+23 SET PXDT=""
+24 IF PXVIEN
SET PXDT=$PIECE($GET(^AUPNVIMM(PXVIEN,12)),U,1)
+25 IF 'PXDT
IF PXVISIT
SET PXDT=$PIECE($GET(^AUPNVSIT(PXVISIT,0)),U,1)
+26 SET PXRSLT=$$LOTSTAT(PXLOT,PXDT)
+27 ;
+28 QUIT PXRSLT
+29 ;
LOTSTAT(PXLOT,PXDT) ; Check if lot is active and not expired
+1 ;
+2 NEW PXEXPDT,PXNODE,PXSTAT,PXSTATDT,PXSTATIEN
+3 ;
+4 IF '$GET(PXDT)
SET PXDT=$$NOW^XLFDT()
+5 ;
+6 SET PXNODE=$GET(^AUTTIML(+$GET(PXLOT),0))
+7 IF PXNODE=""
QUIT 0
+8 ;
+9 ; Check if lot is expired
+10 SET PXEXPDT=$PIECE(PXNODE,U,9)
+11 IF $PIECE(PXDT,".",1)>$PIECE(PXEXPDT,".",1)
QUIT 0
+12 ;
+13 ; if lot is active now, let them select it regardless if it was inactive in the past
+14 IF $PIECE(PXNODE,U,3)'>0
QUIT 1
+15 ;
+16 ; If it's inactive now, see if it was active on PXDT
+17 SET PXSTATIEN=""
+18 IF $DATA(^AUTTIML(PXLOT,1,"B",PXDT))
SET PXSTATIEN=$ORDER(^AUTTIML(PXLOT,1,"B",PXDT,0))
+19 IF 'PXSTATIEN
Begin DoDot:1
+20 SET PXSTATDT=$ORDER(^AUTTIML(PXLOT,1,"B",PXDT),-1)
+21 IF PXSTATDT
SET PXSTATIEN=$ORDER(^AUTTIML(PXLOT,1,"B",PXSTATDT,0))
End DoDot:1
+22 IF PXSTATIEN
SET PXSTAT=$PIECE($GET(^AUTTIML(PXLOT,1,PXSTATIEN,0)),U,3)
+23 IF 'PXSTATIEN
Begin DoDot:1
+24 IF $DATA(^AUTTIML(PXLOT,1,"B"))
SET PXSTAT=0
QUIT
+25 SET PXSTAT=$PIECE(PXNODE,U,3)
End DoDot:1
+26 IF PXSTAT>0
QUIT 0
+27 ;
+28 QUIT 1
+29 ;
IMMSEL(PXVLOT,PXVIN) ; is this lot # selectable for this facility
+1 NEW PXVST
+2 SET PXVST=0
+3 IF $DATA(^AUTTIML("AF",PXVIN,PXVLOT))!($PIECE(^AUTTIML(PXVLOT,0),"^",10)="")
SET PXVST=1
+4 QUIT PXVST
+5 ;
LOT() ;
+1 NEW PXVIMM,PXVLN
+2 SET PXVIMM=0
Begin DoDot:1
+3 SET PXVLN=0
FOR
SET PXVLN=$ORDER(^AUTTIML("C",Y,PXVLN))
if 'PXVLN
QUIT
IF $PIECE(^AUTTIML(PXVLN,0),"^",12)>0
SET PXVIMM=1
QUIT
End DoDot:1
QUIT PXVIMM
+4 QUIT
+5 ;
DIV1(PXVISIT) ; return division associated with the encounter
+1 NEW PXVL
+2 SET (PXVIN,PXVL)=""
+3 IF PXVISIT
Begin DoDot:1
+4 SET PXVL=$PIECE(^AUPNVSIT(PXVISIT,0),"^",22)
+5 IF PXVL
SET PXVIN=$PIECE(^SC(PXVL,0),"^",4)
+6 ; if hospital location institution is null, set institution to LOC. OF ENCOUNTER in VISIT file
+7 ; else set institution to Kernel default institution
+8 IF 'PXVIN
SET PXVIN=$SELECT($PIECE(^AUPNVSIT(PXVISIT,0),"^",6):$PIECE(^AUPNVSIT(PXVISIT,0),"^",6),$GET(DUZ(2)):$GET(DUZ(2)),1:$$KSP^XUPARAM("INST"))
End DoDot:1
+9 QUIT PXVIN
+10 ;
HIST() ; check if historical encounter
+1 NEW PXVIEN,PXVHIST,PXVSIT,PXVSRCE
+2 SET PXVHIST=0
+3 SET PXVIEN=$SELECT($GET(DA):DA,$GET(PXKPIEN):PXKPIEN,$GET(PXVNEWIM):PXVNEWIM,1:"")
IF 'PXVIEN
QUIT PXVHIST
+4 SET PXVSRCE=$PIECE($GET(^AUPNVIMM(PXVIEN,13)),"^")
+5 IF PXVSRCE=""
IF $GET(PXKAFT("13"))
SET PXVSRCE=$PIECE(PXKAFT("13"),"^")
+6 IF PXVSRCE
SET PXVHIST=$SELECT(PXVSRCE=$ORDER(^PXV(920.1,"H","00",0)):0,1:1)
QUIT PXVHIST
+7 SET PXVSIT=$PIECE(^AUPNVIMM(PXVIEN,0),"^",3)
+8 IF $PIECE($GET(^AUPNVSIT(PXVSIT,0)),"^",7)="E"
SET PXVHIST=1
+9 QUIT PXVHIST
+10 ;
DECR ; set logic for AF x-ref in V IMMUNIZATION file
+1 ; decrement doses unused in IMMUNIZATION LOT file
+2 ; check if "low stock" message needs to be sent
+3 ;
+4 NEW PXV,PXCURSTOCK,PXIMM,PXINST,PXLOT,PXOLDSTOCK,PXTHRESHOLD,PXVISIT,PXVIMM
+5 ;
+6 SET PXVIMM=+$GET(DA)
+7 SET PXLOT=+$GET(X)
+8 ;
+9 Begin DoDot:1
+10 NEW DA,X
+11 ;
+12 IF $$HIST
QUIT
+13 ;
+14 SET PXIMM=$PIECE($GET(^AUPNVIMM(PXVIMM,0)),U,1)
+15 IF 'PXIMM
QUIT
+16 SET PXVISIT=$PIECE($GET(^AUPNVIMM(PXVIMM,0)),U,3)
+17 SET PXINST=+$$DIV1(PXVISIT)
+18 ;
+19 LOCK +^AUTTIML("C",PXIMM):$GET(DILOCKTM,3)
+20 SET PXOLDSTOCK=$$STOCKQTY(PXINST,PXIMM)
+21 SET PXV=$PIECE($GET(^AUTTIML(PXLOT,0)),"^",12)
+22 IF 'PXV
Begin DoDot:2
+23 LOCK -^AUTTIML("C",PXIMM)
End DoDot:2
QUIT
+24 SET PXV=PXV-1
+25 SET $PIECE(^AUTTIML(PXLOT,0),"^",12)=PXV
+26 LOCK -^AUTTIML("C",PXIMM)
+27 ;
+28 ; check if need to send low stock message
+29 IF '$$GET^XPAR("DIV.`"_PXINST_"^SYS^PKG","PXV IMM INVENTORY ALERTS",1,"I")
QUIT
+30 SET PXTHRESHOLD=+$PIECE(PXOLDSTOCK,U,2)
+31 SET PXOLDSTOCK=$PIECE(PXOLDSTOCK,U,1)
+32 SET PXCURSTOCK=PXOLDSTOCK-1
+33 IF PXOLDSTOCK>PXTHRESHOLD
IF PXCURSTOCK'>PXTHRESHOLD
DO SENDMSG(PXINST,PXIMM,PXCURSTOCK)
End DoDot:1
+34 ;
+35 QUIT
+36 ;
INCR ; kill logic for AF x-ref in V IMMUNIZATION file
+1 ; increment doses unused in IMMUNIZATION LOT file
+2 IF $$HIST
QUIT
+3 NEW PXV
+4 SET PXV=$PIECE($GET(^AUTTIML(X,0)),"^",12)
IF PXV=""
QUIT
+5 SET PXV=PXV+1
SET $PIECE(^AUTTIML(X,0),"^",12)=PXV
+6 QUIT
+7 ;
STOCKQTY(PXINST,PXIMM) ;
+1 ; Return the total active stock for this imm/div.
+2 ; Also, return the largest Low Supply Alert value (this will be used as
+3 ; the threshold to see if an alert should be sent).
+4 ;
+5 NEW PXLOTNUM,PXNODE0,PXSTOCK,PXTHRESHOLD,PXX
+6 SET PXTHRESHOLD=0
+7 SET PXSTOCK=0
+8 SET PXLOTNUM=0
+9 FOR
SET PXLOTNUM=$ORDER(^AUTTIML("C",PXIMM,PXLOTNUM))
if 'PXLOTNUM
QUIT
Begin DoDot:1
+10 SET PXNODE0=$GET(^AUTTIML(PXLOTNUM,0))
+11 ;Quit if Inactive or expired
IF '$$LOTSTAT(PXLOTNUM)
QUIT
+12 ;not linked to this div
IF '$$IMMSEL(PXLOTNUM,PXINST)
QUIT
+13 SET PXSTOCK=PXSTOCK+$PIECE(PXNODE0,U,12)
+14 SET PXX=$PIECE(PXNODE0,U,15)
+15 IF PXX>PXTHRESHOLD
SET PXTHRESHOLD=PXX
End DoDot:1
+16 QUIT PXSTOCK_U_PXTHRESHOLD
+17 ;
SENDMSG(PXINST,PXIMM,PXSTOCK) ; Send MailMan message that stock is low
+1 NEW DIWF,DIWL,DIWR,PXBODY,PXIMMNAME,PXINSTNM,PXINSTR,PXMSG,PXTO,X
+2 SET PXIMMNAME=$PIECE($GET(^AUTTIMM(PXIMM,0)),"^",1)
+3 SET PXINSTNM=$PIECE($$NS^XUAF4(PXINST),U,1)
+4 SET PXMSG="Low stock of "_$EXTRACT(PXIMMNAME,1,25)_" for "_$EXTRACT(PXINSTNM,1,20)
+5 DO EN^DDIOL(">> "_PXMSG_"! <<",,"!!,?2")
+6 MERGE PXTO=^XUSEC("PXV IMM INVENTORY MGR")
+7 SET PXTO("G.PXV IMM INVENTORY ALERTS")=""
+8 SET X="Low stock of "_PXIMMNAME_" for "_PXINSTNM_". There are "_PXSTOCK_" doses remaining."
+9 KILL ^UTILITY($JOB,"W")
+10 SET DIWL=1
+11 SET DIWR=80
+12 SET DIWF="|"
+13 DO ^DIWP
+14 MERGE PXBODY=^UTILITY($JOB,"W",1)
+15 KILL ^UTILITY($JOB,"W")
+16 SET PXINSTR("FROM")="PXV IMM INVENTORY MGR"
+17 SET PXINSTR("LATER")=$$NOW^XLFDT
+18 DO SENDMSG^XMXAPI(DUZ,PXMSG,"PXBODY",.PXTO,.PXINSTR)
+19 QUIT
+20 ;
+21 ;
+22 ; Update Immunization Lot Effective Date/Time multiple
+23 ; Called from AH x-ref IMMUNIZATION LOT file
UPDSTAT(PXIEN,PXOLDSTATUS,PXNEWSTATUS,PXDT,PXUSER) ;
+1 ;
+2 NEW PXIENSUB,PXX
+3 ;
+4 IF '$GET(PXIEN)
QUIT
+5 IF '$DATA(^AUTTIML(PXIEN,0))
QUIT
+6 SET PXOLDSTATUS=$GET(PXOLDSTATUS)
+7 SET PXNEWSTATUS=$GET(PXNEWSTATUS)
+8 IF '$GET(PXDT)
SET PXDT=$$NOW^XLFDT()
+9 IF '$GET(PXUSER)
SET PXUSER=DUZ
+10 ;
+11 IF PXOLDSTATUS=PXNEWSTATUS
IF $ORDER(^AUTTIML(PXIEN,1,0))
QUIT
+12 ;
+13 FOR
if '$DATA(^AUTTIML(PXIEN,1,"B",PXDT))
QUIT
Begin DoDot:1
+14 SET PXDT=$$FMADD^XLFDT(PXDT,,,,1)
End DoDot:1
+15 ;
+16 SET PXIENSUB=$ORDER(^AUTTIML(PXIEN,1,"A"),-1)+1
+17 FOR
if '$DATA(^AUTTIML(PXIEN,1,PXIENSUB))
QUIT
Begin DoDot:1
+18 SET PXIENSUB=PXIENSUB+1
End DoDot:1
+19 ;
+20 ; this this is called from a x-ref, trying to avoid making
+21 ; a new FileMan call, and instead using direct sets.
+22 SET ^AUTTIML(PXIEN,1,PXIENSUB,0)=PXDT_U_PXUSER_U_PXNEWSTATUS
+23 SET ^AUTTIML(PXIEN,1,"B",PXDT,PXIENSUB)=""
+24 IF $GET(^AUTTIML(PXIEN,1,0))=""
SET ^AUTTIML(PXIEN,1,0)="^9999999.411DA^0^0"
+25 SET PXX=$PIECE(^AUTTIML(PXIEN,1,0),4)+1
+26 SET $PIECE(^AUTTIML(PXIEN,1,0),U,3,4)=PXIENSUB_U_PXX
+27 ;
+28 QUIT
