Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXVTRAN

PXVTRAN.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. EN(PXINST,PXTITLE) ;
  1. ;
  1. N PXADD,PXCONF,PXEXIT,PXVAC,PXQTY,PXTO
  1. ;
  1. I '$O(^AUTTIML("AF",PXINST,0)) D Q
  1. . W $C(7),!!,"There are no vaccine lots in the transferring facility.",!!
  1. . H 1
  1. ;
  1. F D Q:$G(PXEXIT)
  1. . W @IOF,?10,"Transfer Vaccine Inventory From "_PXTITLE,!
  1. . S PXVAC=$$VAC(PXINST)
  1. . I PXVAC<1 S PXEXIT=1 Q
  1. . S PXQTY=$$QTY(PXVAC)
  1. . I PXQTY=0 W ! Q
  1. . I PXQTY<0 S PXEXIT=1 Q
  1. . S PXTO=$$TO(PXINST)
  1. . I PXTO=0 W ! Q
  1. . I PXTO<0 S PXEXIT=1 Q
  1. . S PXADD=$$ADDCHK(PXVAC,PXTO)
  1. . I PXADD=0 W ! Q
  1. . I PXADD<0 S PXEXIT=1 Q
  1. . S PXCONF=$$CONF(PXVAC,PXQTY,PXINST,PXTO)
  1. . I PXCONF=0 W ! Q
  1. . I PXCONF<0 S PXEXIT=1 Q
  1. . D TRAN(PXVAC,PXQTY,PXTO,PXADD)
  1. ;
  1. Q
  1. ;
  1. VAC(PXINST) ;
  1. ;
  1. N DIC,DIDIC,DINUM,DLAYGO,X,Y,PXVAC,DTOUT,DUOUT
  1. ;
  1. S PXVAC=""
  1. ;
  1. W !
  1. S DIC("S")="I $P(^(0),""^"",10)="_PXINST_"&($P(^(0),""^"",9)'<DT)&('$P(^(0),""^"",3))"
  1. S DIC(0)="AEMQ"
  1. S DIC="^AUTTIML("
  1. D ^DIC
  1. I $D(DTOUT)!($D(DUOUT)) Q -1
  1. I Y<1 Q 0
  1. ;
  1. S PXVAC=+Y
  1. Q PXVAC
  1. ;
  1. QTY(PXVAC) ;
  1. ;
  1. N DIR,X,Y,PXBAL,PXQTY,DTOUT,DUOUT
  1. ;
  1. S PXBAL=$P($G(^AUTTIML(PXVAC,0)),U,12)
  1. ;
  1. I PXBAL'>0 D Q 0
  1. . W $C(7),!!,"This vaccine lot has a "_$S(PXBAL=0:"zero",1:"negative")_" balance."
  1. . W !,"Select another vaccine lot to transfer.",!
  1. . H 2
  1. ;
  1. W !!,?5,"Current Balance: "_PXBAL,!
  1. S DIR(0)="NO^1:"_PXBAL_":0"
  1. S DIR("A")="Enter Quantity to Transfer"
  1. S DIR("?",1)="Enter a whole number between 1 and "_PXBAL_"."
  1. S DIR("?")="This is the number of doses to transfer."
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) Q -1
  1. I Y<1 Q 0
  1. S PXQTY=+Y
  1. Q PXQTY
  1. ;
  1. TO(PXINST) ;
  1. ;
  1. N DIR,X,Y,PXTO,DTOUT,DUOUT
  1. ;
  1. ;S DIR(0)="9999999.41,.1"
  1. S DIR(0)="P^4:AEQM"
  1. S DIR("A")="Enter the facility name or station number"
  1. S DIR("S")="I Y'="_PXINST
  1. S DIR("?")="Enter the facility that will be receiving the vaccines."
  1. D ^DIR
  1. ;
  1. I $D(DTOUT)!($D(DUOUT)) Q -1
  1. I Y<1 Q 0
  1. ;
  1. S PXTO=+Y
  1. Q PXTO
  1. ;
  1. ADDCHK(PXVAC,PXTO) ;
  1. ;
  1. N DIR,X,Y,PXLN,PXVIM,PXMAN,PXVACTO,DTOUT,DUOUT
  1. ;
  1. S PXLN=$P($G(^AUTTIML(PXVAC,0)),U,1)
  1. S PXVIM=$P($G(^AUTTIML(PXVAC,0)),U,4)
  1. S PXMAN=$P($G(^AUTTIML(PXVAC,0)),U,2)
  1. I PXVIM=""!(PXMAN="") Q -1
  1. S PXVACTO=$O(^AUTTIML("AC",PXVIM,PXMAN,PXLN_"_#"_PXTO,0))
  1. I PXVACTO Q "0^"_PXVACTO
  1. ;
  1. W $C(7),!!,$P($$NS^XUAF4(PXTO),U)_" does not currently stock this lot!",!
  1. S DIR(0)="Y"
  1. S DIR("A")="Do you want to continue"
  1. S DIR("?",1)="Answer 'YES' to add this vaccine lot to the receiving facility."
  1. S DIR("?")="Answer 'NO' to quit this transfer request."
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) Q -1
  1. I Y<1 Q 0
  1. Q +Y
  1. ;
  1. CONF(PXVAC,PXQTY,PXINST,PXTO) ;
  1. ;
  1. N DIR,X,Y,PXLINE,PXLN,PXVIM,PXMAN,PXX,DTOUT,DUOUT
  1. ;
  1. S PXLN=$P($G(^AUTTIML(PXVAC,0)),U,1)
  1. S PXVIM=$$GET1^DIQ(9999999.41,PXVAC_",",.04)
  1. S PXMAN=$$GET1^DIQ(9999999.41,PXVAC_",",.02)
  1. ;
  1. S $P(PXLINE,"-",80)=""
  1. W @IOF,!,PXLINE
  1. W !,PXVIM
  1. W !,"Manufacturer: "_PXMAN
  1. W !,"Lot: "_PXLN
  1. W !,"Exp Date: "_$$FMTE^XLFDT($P($G(^AUTTIML(PXVAC,0)),U,9),"5D")
  1. W !!,"Transferring: "_PXQTY_" (Doses)"
  1. S PXX=$$NS^XUAF4(PXINST)
  1. W !!,"From: "_$P(PXX,U)_" ("_$P(PXX,U,2)_")"
  1. S PXX=$$NS^XUAF4(PXTO)
  1. W !,"To : "_$P(PXX,U)_" ("_$P(PXX,U,2)_")"
  1. W !,PXLINE,!
  1. S DIR(0)="Y"
  1. S DIR("A")="OK to post"
  1. S DIR("B")="Yes"
  1. S DIR("?")="Answer 'YES' to post this transfer, 'NO' to quit."
  1. D ^DIR
  1. I $D(DTOUT)!($D(DUOUT)) Q -1
  1. I Y<1 Q 0
  1. Q +Y
  1. ;
  1. TRAN(PXVAC,PXQTY,PXTO,PXADD) ;
  1. ;
  1. N PXFQTY,PXTQTY,PXVACTO,PXFDA
  1. ;
  1. W !!,"Updating vaccine on-hand balances now..."
  1. ;
  1. S PXFQTY=$P($G(^AUTTIML(PXVAC,0)),U,12)-PXQTY
  1. I PXFQTY<0 S PXFQTY=0
  1. S PXFDA(9999999.41,PXVAC_",",.12)=PXFQTY
  1. I PXADD D ADD(PXVAC,PXQTY,PXTO)
  1. I 'PXADD D
  1. . S PXVACTO=$P(PXADD,U,2)
  1. . S PXTQTY=$P($G(^AUTTIML(PXVACTO,0)),U,12)+PXQTY
  1. . S PXFDA(9999999.41,PXVACTO_",",.12)=PXTQTY
  1. ;
  1. D FILE^DIE("","PXFDA","PXERR")
  1. ;
  1. W !,"Done!",!
  1. H 1
  1. ;
  1. Q
  1. ;
  1. ADD(PXVAC,PXQTY,PXTO) ;
  1. ;
  1. N PXNODE,PXIENS,PXFDA
  1. ;
  1. S PXNODE=$G(^AUTTIML(PXVAC,0))
  1. S PXIENS="+1,"
  1. S PXFDA(1,9999999.41,PXIENS,.01)=$P(PXNODE,U,1)
  1. S PXFDA(1,9999999.41,PXIENS,.02)=$P(PXNODE,U,2)
  1. S PXFDA(1,9999999.41,PXIENS,.03)=$P(PXNODE,U,3)
  1. S PXFDA(1,9999999.41,PXIENS,.04)=$P(PXNODE,U,4)
  1. S PXFDA(1,9999999.41,PXIENS,.09)=$P(PXNODE,U,9)
  1. S PXFDA(1,9999999.41,PXIENS,.1)=PXTO
  1. S PXFDA(1,9999999.41,PXIENS,.11)=PXQTY
  1. S PXFDA(1,9999999.41,PXIENS,.12)=PXQTY
  1. S PXFDA(1,9999999.41,PXIENS,.15)=$P(PXNODE,U,15)
  1. S PXFDA(1,9999999.41,PXIENS,.18)=$P(PXNODE,U,18)
  1. ;
  1. D UPDATE^DIE("U","PXFDA(1)")
  1. ;
  1. Q