PXVXR ;BIR/ADM - CROSS REFERENCE AND OTHER LOGIC ;08/21/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**210,216,211**;Aug 12, 1996;Build 454
;
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() ; screen immunization with active immunization lot number
N PXVIMM,PXVVAC
S PXVIMM=0 D I PXVIMM=0 Q PXVIMM
.I $D(DA),$D(^AUTTIML("C",$P(^AUPNVIMM(DA,0),U),Y)) S PXVIMM=1 Q
.I $G(PXCEFIEN),$D(^AUTTIML("C",$P(^AUPNVIMM(PXCEFIEN,0),U),Y)) S PXVIMM=1 Q
.I $D(PXD),$D(^AUTTIML("C",$P(PXD,"^"),Y)) S PXVIMM=1 Q
I '$$DIV S PXVIMM=0
Q PXVIMM
;
DIV() ; screen for division
N PXVIN,PXVL,PXVST,PXVV
S PXVST=0
S PXVV=$S($G(DA):$P(^AUPNVIMM(DA,0),"^",3),$G(PXCEVIEN):PXCEVIEN,$G(PXVISIEN):PXVISIEN,1:0)
I PXVV=0 S PXVIN=$S($G(DUZ(2)):$G(DUZ(2)),1:$$KSP^XUPARAM("INST"))
I PXVV>0 D
. S PXVL=$S(PXVV:$P(^AUPNVSIT(PXVV,0),"^",22),1:0)
. S PXVIN=$S(PXVL:$P(^SC(PXVL,0),"^",4),1:0)
. I 'PXVIN D
.. N LOCENC
.. S LOCENC=$P(^AUPNVSIT(PXVV,0),U,6)
.. S PXVIN=$S(LOCENC:LOCENC,$G(DUZ(2)):$G(DUZ(2)),1:$$KSP^XUPARAM("INST"))
I PXVIN,$$IMMSEL(Y,PXVIN) S PXVST=1
Q PXVST
;
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
STOCK ; check for availability of stock in immunization inventory for selected immunization
; decrement inventory level if not historical event
N PXVDA,PXVIEN,PXVIMM,PXVIN,PXVLN,PXVSTOCK,PXVISIT,X
I $$HIST Q
S PXVDA=$S($G(DA):DA,$G(PXKPIEN):PXKPIEN,$G(PXVNEWIM):PXVNEWIM,1:"") Q:'$G(PXVDA)
S (PXVLN,PXVSTOCK)=0,PXVIEN=$P(^AUPNVIMM(PXVDA,0),"^")
I '$O(^AUTTIML("C",PXVIEN,PXVLN)) Q
S PXVISIT=$S($G(PXCEVIEN):PXCEVIEN,$G(PXKVST):PXKVST,1:"") S PXVIN=$$DIV1(PXVISIT)
F S PXVLN=$O(^AUTTIML("C",PXVIEN,PXVLN)) Q:'PXVLN I '$P(^AUTTIML(PXVLN,0),"^",3),$P(^AUTTIML(PXVLN,0),"^",12)>0 D
.I ($D(^AUTTIML("AF",PXVIN,PXVLN))!($P(^AUTTIML(PXVLN,0),"^",10)="")) S PXVSTOCK=1 Q
;I 'PXVSTOCK S PXVIMM=$P(^AUTTIMM(PXVIEN,0),"^") D ; alert disabled - 09/29/2016 AM
;.D EN^DDIOL(">> No stock available for "_PXVIMM_"! <<",,"!!,?2")
;.D ALERT
S X=$P($G(^AUPNVIMM(PXVDA,12)),"^",7) I $G(X) D DECR
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
;
ALERT ; send alert if no stock available
N XQA,XQAMSG,PXVVAR
S XQA(DUZ)=""
S XQAMSG="No stock available for "_PXVIMM_"!"
S PXVVAR=$$SETUP1^XQALERT
Q
DECR ; set logic for AF x-ref in V IMMUNIZATION file
; decrement 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
K PXVNEWIM
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVXR 5454 printed May 06, 2022@01:13:35 Page 2
PXVXR ;BIR/ADM - CROSS REFERENCE AND OTHER LOGIC ;08/21/2020
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**210,216,211**;Aug 12, 1996;Build 454
+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
ACT() ; screen immunization with active immunization lot number
+1 NEW PXVIMM,PXVVAC
+2 SET PXVIMM=0
Begin DoDot:1
+3 IF $DATA(DA)
IF $DATA(^AUTTIML("C",$PIECE(^AUPNVIMM(DA,0),U),Y))
SET PXVIMM=1
QUIT
+4 IF $GET(PXCEFIEN)
IF $DATA(^AUTTIML("C",$PIECE(^AUPNVIMM(PXCEFIEN,0),U),Y))
SET PXVIMM=1
QUIT
+5 IF $DATA(PXD)
IF $DATA(^AUTTIML("C",$PIECE(PXD,"^"),Y))
SET PXVIMM=1
QUIT
End DoDot:1
IF PXVIMM=0
QUIT PXVIMM
+6 IF '$$DIV
SET PXVIMM=0
+7 QUIT PXVIMM
+8 ;
DIV() ; screen for division
+1 NEW PXVIN,PXVL,PXVST,PXVV
+2 SET PXVST=0
+3 SET PXVV=$SELECT($GET(DA):$PIECE(^AUPNVIMM(DA,0),"^",3),$GET(PXCEVIEN):PXCEVIEN,$GET(PXVISIEN):PXVISIEN,1:0)
+4 IF PXVV=0
SET PXVIN=$SELECT($GET(DUZ(2)):$GET(DUZ(2)),1:$$KSP^XUPARAM("INST"))
+5 IF PXVV>0
Begin DoDot:1
+6 SET PXVL=$SELECT(PXVV:$PIECE(^AUPNVSIT(PXVV,0),"^",22),1:0)
+7 SET PXVIN=$SELECT(PXVL:$PIECE(^SC(PXVL,0),"^",4),1:0)
+8 IF 'PXVIN
Begin DoDot:2
+9 NEW LOCENC
+10 SET LOCENC=$PIECE(^AUPNVSIT(PXVV,0),U,6)
+11 SET PXVIN=$SELECT(LOCENC:LOCENC,$GET(DUZ(2)):$GET(DUZ(2)),1:$$KSP^XUPARAM("INST"))
End DoDot:2
End DoDot:1
+12 IF PXVIN
IF $$IMMSEL(Y,PXVIN)
SET PXVST=1
+13 QUIT PXVST
+14 ;
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
STOCK ; check for availability of stock in immunization inventory for selected immunization
+1 ; decrement inventory level if not historical event
+2 NEW PXVDA,PXVIEN,PXVIMM,PXVIN,PXVLN,PXVSTOCK,PXVISIT,X
+3 IF $$HIST
QUIT
+4 SET PXVDA=$SELECT($GET(DA):DA,$GET(PXKPIEN):PXKPIEN,$GET(PXVNEWIM):PXVNEWIM,1:"")
if '$GET(PXVDA)
QUIT
+5 SET (PXVLN,PXVSTOCK)=0
SET PXVIEN=$PIECE(^AUPNVIMM(PXVDA,0),"^")
+6 IF '$ORDER(^AUTTIML("C",PXVIEN,PXVLN))
QUIT
+7 SET PXVISIT=$SELECT($GET(PXCEVIEN):PXCEVIEN,$GET(PXKVST):PXKVST,1:"")
SET PXVIN=$$DIV1(PXVISIT)
+8 FOR
SET PXVLN=$ORDER(^AUTTIML("C",PXVIEN,PXVLN))
if 'PXVLN
QUIT
IF '$PIECE(^AUTTIML(PXVLN,0),"^",3)
IF $PIECE(^AUTTIML(PXVLN,0),"^",12)>0
Begin DoDot:1
+9 IF ($DATA(^AUTTIML("AF",PXVIN,PXVLN))!($PIECE(^AUTTIML(PXVLN,0),"^",10)=""))
SET PXVSTOCK=1
QUIT
End DoDot:1
+10 ;I 'PXVSTOCK S PXVIMM=$P(^AUTTIMM(PXVIEN,0),"^") D ; alert disabled - 09/29/2016 AM
+11 ;.D EN^DDIOL(">> No stock available for "_PXVIMM_"! <<",,"!!,?2")
+12 ;.D ALERT
+13 SET X=$PIECE($GET(^AUPNVIMM(PXVDA,12)),"^",7)
IF $GET(X)
DO DECR
+14 QUIT
+15 ;
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 ;
ALERT ; send alert if no stock available
+1 NEW XQA,XQAMSG,PXVVAR
+2 SET XQA(DUZ)=""
+3 SET XQAMSG="No stock available for "_PXVIMM_"!"
+4 SET PXVVAR=$$SETUP1^XQALERT
+5 QUIT
DECR ; set logic for AF x-ref in V IMMUNIZATION file
+1 ; decrement 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 KILL PXVNEWIM
+7 QUIT
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
