PXVTRAN ;ISP/LMT - Transfer Vaccine Inventory Between Facilities ;Dec 03, 2018@15:13:49
;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
;
;
EN(PXINST,PXTITLE) ;
;
N PXADD,PXCONF,PXEXIT,PXVAC,PXQTY,PXTO
;
I '$O(^AUTTIML("AF",PXINST,0)) D Q
. W $C(7),!!,"There are no vaccine lots in the transferring facility.",!!
. H 1
;
F D Q:$G(PXEXIT)
. W @IOF,?10,"Transfer Vaccine Inventory From "_PXTITLE,!
. S PXVAC=$$VAC(PXINST)
. I PXVAC<1 S PXEXIT=1 Q
. S PXQTY=$$QTY(PXVAC)
. I PXQTY=0 W ! Q
. I PXQTY<0 S PXEXIT=1 Q
. S PXTO=$$TO(PXINST)
. I PXTO=0 W ! Q
. I PXTO<0 S PXEXIT=1 Q
. S PXADD=$$ADDCHK(PXVAC,PXTO)
. I PXADD=0 W ! Q
. I PXADD<0 S PXEXIT=1 Q
. S PXCONF=$$CONF(PXVAC,PXQTY,PXINST,PXTO)
. I PXCONF=0 W ! Q
. I PXCONF<0 S PXEXIT=1 Q
. D TRAN(PXVAC,PXQTY,PXTO,PXADD)
;
Q
;
VAC(PXINST) ;
;
N DIC,DIDIC,DINUM,DLAYGO,X,Y,PXVAC,DTOUT,DUOUT
;
S PXVAC=""
;
W !
S DIC("S")="I $P(^(0),""^"",10)="_PXINST_"&($P(^(0),""^"",9)'<DT)&('$P(^(0),""^"",3))"
S DIC(0)="AEMQ"
S DIC="^AUTTIML("
D ^DIC
I $D(DTOUT)!($D(DUOUT)) Q -1
I Y<1 Q 0
;
S PXVAC=+Y
Q PXVAC
;
QTY(PXVAC) ;
;
N DIR,X,Y,PXBAL,PXQTY,DTOUT,DUOUT
;
S PXBAL=$P($G(^AUTTIML(PXVAC,0)),U,12)
;
I PXBAL'>0 D Q 0
. W $C(7),!!,"This vaccine lot has a "_$S(PXBAL=0:"zero",1:"negative")_" balance."
. W !,"Select another vaccine lot to transfer.",!
. H 2
;
W !!,?5,"Current Balance: "_PXBAL,!
S DIR(0)="NO^1:"_PXBAL_":0"
S DIR("A")="Enter Quantity to Transfer"
S DIR("?",1)="Enter a whole number between 1 and "_PXBAL_"."
S DIR("?")="This is the number of doses to transfer."
D ^DIR
I $D(DTOUT)!($D(DUOUT)) Q -1
I Y<1 Q 0
S PXQTY=+Y
Q PXQTY
;
TO(PXINST) ;
;
N DIR,X,Y,PXTO,DTOUT,DUOUT
;
;S DIR(0)="9999999.41,.1"
S DIR(0)="P^4:AEQM"
S DIR("A")="Enter the facility name or station number"
S DIR("S")="I Y'="_PXINST
S DIR("?")="Enter the facility that will be receiving the vaccines."
D ^DIR
;
I $D(DTOUT)!($D(DUOUT)) Q -1
I Y<1 Q 0
;
S PXTO=+Y
Q PXTO
;
ADDCHK(PXVAC,PXTO) ;
;
N DIR,X,Y,PXLN,PXVIM,PXMAN,PXVACTO,DTOUT,DUOUT
;
S PXLN=$P($G(^AUTTIML(PXVAC,0)),U,1)
S PXVIM=$P($G(^AUTTIML(PXVAC,0)),U,4)
S PXMAN=$P($G(^AUTTIML(PXVAC,0)),U,2)
I PXVIM=""!(PXMAN="") Q -1
S PXVACTO=$O(^AUTTIML("AC",PXVIM,PXMAN,PXLN_"_#"_PXTO,0))
I PXVACTO Q "0^"_PXVACTO
;
W $C(7),!!,$P($$NS^XUAF4(PXTO),U)_" does not currently stock this lot!",!
S DIR(0)="Y"
S DIR("A")="Do you want to continue"
S DIR("?",1)="Answer 'YES' to add this vaccine lot to the receiving facility."
S DIR("?")="Answer 'NO' to quit this transfer request."
D ^DIR
I $D(DTOUT)!($D(DUOUT)) Q -1
I Y<1 Q 0
Q +Y
;
CONF(PXVAC,PXQTY,PXINST,PXTO) ;
;
N DIR,X,Y,PXLINE,PXLN,PXVIM,PXMAN,PXX,DTOUT,DUOUT
;
S PXLN=$P($G(^AUTTIML(PXVAC,0)),U,1)
S PXVIM=$$GET1^DIQ(9999999.41,PXVAC_",",.04)
S PXMAN=$$GET1^DIQ(9999999.41,PXVAC_",",.02)
;
S $P(PXLINE,"-",80)=""
W @IOF,!,PXLINE
W !,PXVIM
W !,"Manufacturer: "_PXMAN
W !,"Lot: "_PXLN
W !,"Exp Date: "_$$FMTE^XLFDT($P($G(^AUTTIML(PXVAC,0)),U,9),"5D")
W !!,"Transferring: "_PXQTY_" (Doses)"
S PXX=$$NS^XUAF4(PXINST)
W !!,"From: "_$P(PXX,U)_" ("_$P(PXX,U,2)_")"
S PXX=$$NS^XUAF4(PXTO)
W !,"To : "_$P(PXX,U)_" ("_$P(PXX,U,2)_")"
W !,PXLINE,!
S DIR(0)="Y"
S DIR("A")="OK to post"
S DIR("B")="Yes"
S DIR("?")="Answer 'YES' to post this transfer, 'NO' to quit."
D ^DIR
I $D(DTOUT)!($D(DUOUT)) Q -1
I Y<1 Q 0
Q +Y
;
TRAN(PXVAC,PXQTY,PXTO,PXADD) ;
;
N PXFQTY,PXTQTY,PXVACTO,PXFDA
;
W !!,"Updating vaccine on-hand balances now..."
;
S PXFQTY=$P($G(^AUTTIML(PXVAC,0)),U,12)-PXQTY
I PXFQTY<0 S PXFQTY=0
S PXFDA(9999999.41,PXVAC_",",.12)=PXFQTY
I PXADD D ADD(PXVAC,PXQTY,PXTO)
I 'PXADD D
. S PXVACTO=$P(PXADD,U,2)
. S PXTQTY=$P($G(^AUTTIML(PXVACTO,0)),U,12)+PXQTY
. S PXFDA(9999999.41,PXVACTO_",",.12)=PXTQTY
;
D FILE^DIE("","PXFDA","PXERR")
;
W !,"Done!",!
H 1
;
Q
;
ADD(PXVAC,PXQTY,PXTO) ;
;
N PXNODE,PXIENS,PXFDA
;
S PXNODE=$G(^AUTTIML(PXVAC,0))
S PXIENS="+1,"
S PXFDA(1,9999999.41,PXIENS,.01)=$P(PXNODE,U,1)
S PXFDA(1,9999999.41,PXIENS,.02)=$P(PXNODE,U,2)
S PXFDA(1,9999999.41,PXIENS,.03)=$P(PXNODE,U,3)
S PXFDA(1,9999999.41,PXIENS,.04)=$P(PXNODE,U,4)
S PXFDA(1,9999999.41,PXIENS,.09)=$P(PXNODE,U,9)
S PXFDA(1,9999999.41,PXIENS,.1)=PXTO
S PXFDA(1,9999999.41,PXIENS,.11)=PXQTY
S PXFDA(1,9999999.41,PXIENS,.12)=PXQTY
S PXFDA(1,9999999.41,PXIENS,.15)=$P(PXNODE,U,15)
S PXFDA(1,9999999.41,PXIENS,.18)=$P(PXNODE,U,18)
;
D UPDATE^DIE("U","PXFDA(1)")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVTRAN 4636 printed Apr 09, 2024@21:32:07 Page 2
PXVTRAN ;ISP/LMT - Transfer Vaccine Inventory Between Facilities ;Dec 03, 2018@15:13:49
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
+2 ;
+3 ;
EN(PXINST,PXTITLE) ;
+1 ;
+2 NEW PXADD,PXCONF,PXEXIT,PXVAC,PXQTY,PXTO
+3 ;
+4 IF '$ORDER(^AUTTIML("AF",PXINST,0))
Begin DoDot:1
+5 WRITE $CHAR(7),!!,"There are no vaccine lots in the transferring facility.",!!
+6 HANG 1
End DoDot:1
QUIT
+7 ;
+8 FOR
Begin DoDot:1
+9 WRITE @IOF,?10,"Transfer Vaccine Inventory From "_PXTITLE,!
+10 SET PXVAC=$$VAC(PXINST)
+11 IF PXVAC<1
SET PXEXIT=1
QUIT
+12 SET PXQTY=$$QTY(PXVAC)
+13 IF PXQTY=0
WRITE !
QUIT
+14 IF PXQTY<0
SET PXEXIT=1
QUIT
+15 SET PXTO=$$TO(PXINST)
+16 IF PXTO=0
WRITE !
QUIT
+17 IF PXTO<0
SET PXEXIT=1
QUIT
+18 SET PXADD=$$ADDCHK(PXVAC,PXTO)
+19 IF PXADD=0
WRITE !
QUIT
+20 IF PXADD<0
SET PXEXIT=1
QUIT
+21 SET PXCONF=$$CONF(PXVAC,PXQTY,PXINST,PXTO)
+22 IF PXCONF=0
WRITE !
QUIT
+23 IF PXCONF<0
SET PXEXIT=1
QUIT
+24 DO TRAN(PXVAC,PXQTY,PXTO,PXADD)
End DoDot:1
if $GET(PXEXIT)
QUIT
+25 ;
+26 QUIT
+27 ;
VAC(PXINST) ;
+1 ;
+2 NEW DIC,DIDIC,DINUM,DLAYGO,X,Y,PXVAC,DTOUT,DUOUT
+3 ;
+4 SET PXVAC=""
+5 ;
+6 WRITE !
+7 SET DIC("S")="I $P(^(0),""^"",10)="_PXINST_"&($P(^(0),""^"",9)'<DT)&('$P(^(0),""^"",3))"
+8 SET DIC(0)="AEMQ"
+9 SET DIC="^AUTTIML("
+10 DO ^DIC
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+12 IF Y<1
QUIT 0
+13 ;
+14 SET PXVAC=+Y
+15 QUIT PXVAC
+16 ;
QTY(PXVAC) ;
+1 ;
+2 NEW DIR,X,Y,PXBAL,PXQTY,DTOUT,DUOUT
+3 ;
+4 SET PXBAL=$PIECE($GET(^AUTTIML(PXVAC,0)),U,12)
+5 ;
+6 IF PXBAL'>0
Begin DoDot:1
+7 WRITE $CHAR(7),!!,"This vaccine lot has a "_$SELECT(PXBAL=0:"zero",1:"negative")_" balance."
+8 WRITE !,"Select another vaccine lot to transfer.",!
+9 HANG 2
End DoDot:1
QUIT 0
+10 ;
+11 WRITE !!,?5,"Current Balance: "_PXBAL,!
+12 SET DIR(0)="NO^1:"_PXBAL_":0"
+13 SET DIR("A")="Enter Quantity to Transfer"
+14 SET DIR("?",1)="Enter a whole number between 1 and "_PXBAL_"."
+15 SET DIR("?")="This is the number of doses to transfer."
+16 DO ^DIR
+17 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+18 IF Y<1
QUIT 0
+19 SET PXQTY=+Y
+20 QUIT PXQTY
+21 ;
TO(PXINST) ;
+1 ;
+2 NEW DIR,X,Y,PXTO,DTOUT,DUOUT
+3 ;
+4 ;S DIR(0)="9999999.41,.1"
+5 SET DIR(0)="P^4:AEQM"
+6 SET DIR("A")="Enter the facility name or station number"
+7 SET DIR("S")="I Y'="_PXINST
+8 SET DIR("?")="Enter the facility that will be receiving the vaccines."
+9 DO ^DIR
+10 ;
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+12 IF Y<1
QUIT 0
+13 ;
+14 SET PXTO=+Y
+15 QUIT PXTO
+16 ;
ADDCHK(PXVAC,PXTO) ;
+1 ;
+2 NEW DIR,X,Y,PXLN,PXVIM,PXMAN,PXVACTO,DTOUT,DUOUT
+3 ;
+4 SET PXLN=$PIECE($GET(^AUTTIML(PXVAC,0)),U,1)
+5 SET PXVIM=$PIECE($GET(^AUTTIML(PXVAC,0)),U,4)
+6 SET PXMAN=$PIECE($GET(^AUTTIML(PXVAC,0)),U,2)
+7 IF PXVIM=""!(PXMAN="")
QUIT -1
+8 SET PXVACTO=$ORDER(^AUTTIML("AC",PXVIM,PXMAN,PXLN_"_#"_PXTO,0))
+9 IF PXVACTO
QUIT "0^"_PXVACTO
+10 ;
+11 WRITE $CHAR(7),!!,$PIECE($$NS^XUAF4(PXTO),U)_" does not currently stock this lot!",!
+12 SET DIR(0)="Y"
+13 SET DIR("A")="Do you want to continue"
+14 SET DIR("?",1)="Answer 'YES' to add this vaccine lot to the receiving facility."
+15 SET DIR("?")="Answer 'NO' to quit this transfer request."
+16 DO ^DIR
+17 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+18 IF Y<1
QUIT 0
+19 QUIT +Y
+20 ;
CONF(PXVAC,PXQTY,PXINST,PXTO) ;
+1 ;
+2 NEW DIR,X,Y,PXLINE,PXLN,PXVIM,PXMAN,PXX,DTOUT,DUOUT
+3 ;
+4 SET PXLN=$PIECE($GET(^AUTTIML(PXVAC,0)),U,1)
+5 SET PXVIM=$$GET1^DIQ(9999999.41,PXVAC_",",.04)
+6 SET PXMAN=$$GET1^DIQ(9999999.41,PXVAC_",",.02)
+7 ;
+8 SET $PIECE(PXLINE,"-",80)=""
+9 WRITE @IOF,!,PXLINE
+10 WRITE !,PXVIM
+11 WRITE !,"Manufacturer: "_PXMAN
+12 WRITE !,"Lot: "_PXLN
+13 WRITE !,"Exp Date: "_$$FMTE^XLFDT($PIECE($GET(^AUTTIML(PXVAC,0)),U,9),"5D")
+14 WRITE !!,"Transferring: "_PXQTY_" (Doses)"
+15 SET PXX=$$NS^XUAF4(PXINST)
+16 WRITE !!,"From: "_$PIECE(PXX,U)_" ("_$PIECE(PXX,U,2)_")"
+17 SET PXX=$$NS^XUAF4(PXTO)
+18 WRITE !,"To : "_$PIECE(PXX,U)_" ("_$PIECE(PXX,U,2)_")"
+19 WRITE !,PXLINE,!
+20 SET DIR(0)="Y"
+21 SET DIR("A")="OK to post"
+22 SET DIR("B")="Yes"
+23 SET DIR("?")="Answer 'YES' to post this transfer, 'NO' to quit."
+24 DO ^DIR
+25 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+26 IF Y<1
QUIT 0
+27 QUIT +Y
+28 ;
TRAN(PXVAC,PXQTY,PXTO,PXADD) ;
+1 ;
+2 NEW PXFQTY,PXTQTY,PXVACTO,PXFDA
+3 ;
+4 WRITE !!,"Updating vaccine on-hand balances now..."
+5 ;
+6 SET PXFQTY=$PIECE($GET(^AUTTIML(PXVAC,0)),U,12)-PXQTY
+7 IF PXFQTY<0
SET PXFQTY=0
+8 SET PXFDA(9999999.41,PXVAC_",",.12)=PXFQTY
+9 IF PXADD
DO ADD(PXVAC,PXQTY,PXTO)
+10 IF 'PXADD
Begin DoDot:1
+11 SET PXVACTO=$PIECE(PXADD,U,2)
+12 SET PXTQTY=$PIECE($GET(^AUTTIML(PXVACTO,0)),U,12)+PXQTY
+13 SET PXFDA(9999999.41,PXVACTO_",",.12)=PXTQTY
End DoDot:1
+14 ;
+15 DO FILE^DIE("","PXFDA","PXERR")
+16 ;
+17 WRITE !,"Done!",!
+18 HANG 1
+19 ;
+20 QUIT
+21 ;
ADD(PXVAC,PXQTY,PXTO) ;
+1 ;
+2 NEW PXNODE,PXIENS,PXFDA
+3 ;
+4 SET PXNODE=$GET(^AUTTIML(PXVAC,0))
+5 SET PXIENS="+1,"
+6 SET PXFDA(1,9999999.41,PXIENS,.01)=$PIECE(PXNODE,U,1)
+7 SET PXFDA(1,9999999.41,PXIENS,.02)=$PIECE(PXNODE,U,2)
+8 SET PXFDA(1,9999999.41,PXIENS,.03)=$PIECE(PXNODE,U,3)
+9 SET PXFDA(1,9999999.41,PXIENS,.04)=$PIECE(PXNODE,U,4)
+10 SET PXFDA(1,9999999.41,PXIENS,.09)=$PIECE(PXNODE,U,9)
+11 SET PXFDA(1,9999999.41,PXIENS,.1)=PXTO
+12 SET PXFDA(1,9999999.41,PXIENS,.11)=PXQTY
+13 SET PXFDA(1,9999999.41,PXIENS,.12)=PXQTY
+14 SET PXFDA(1,9999999.41,PXIENS,.15)=$PIECE(PXNODE,U,15)
+15 SET PXFDA(1,9999999.41,PXIENS,.18)=$PIECE(PXNODE,U,18)
+16 ;
+17 DO UPDATE^DIE("U","PXFDA(1)")
+18 ;
+19 QUIT
