PRCPBAL1 ;WISC/RFJ-process barcode data ;04 Dec 92
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
EEITEMS ; called from protocol file to enter/edit invpt items
D FULL^VALM1
N PRC,PRCP
D ^PRCPEILM
D BUILD^PRCPBALB
S VALMBCK="R"
Q
;
;
EDITQTY ; called from protocol file to edit quantities
D FULL^VALM1
N %,D0,DA,DI,DIC,DIE,DQ,DR,I,J,X,Y
S (DIC,DIE)="^PRCT(446.4,"_PRCTDA_",2,",DA(1)=PRCTDA,DA=PRCTDA1,DR=1
D ^DIE
D BUILD^PRCPBALB
S VALMBCK="R"
Q
;
;
POST ; called from protocol file to post quantities
D FULL^VALM1
S VALMBCK="R"
N %,%H,%I,DA,DIC,DIK,INVPT,ITEMDA,QTY,RECORD,PRCPBALM
S XP="*** ARE YOU SURE ***",XP(1)="YOU WANT TO UPDATE ON HAND BALANCES IN BARCODED INVENTORY POINTS",XH="ENTER 'YES' TO UPDATE THE QUANTITIES IN THE INVENTORY POINTS."
W ! I $$YN^PRCPUYN(2)'=1 Q
;
I $G(PRCPFSCA) D Q:%<1
. K X S X(1)="Some of the items to upload have been scanned more than once. You have the option to: 1) Upload the LAST SCAN of the item only; or 2) ADD THE QUANTITIES together for all scans of the item." D DISPLAY^PRCPUX2(5,75,.X)
. S XP="Do you want to ADD THE QUANTITIES TOGETHER",XH="Enter YES to add the quantities together,",XH(1)=" NO to only upload the last scan of the item, or ^ to exit."
. S %=$$YN^PRCPUYN(2) S PRCPFSCA=$S(%=1:1,1:0)
;
S INVPT=0 F S INVPT=$O(^TMP($J,"PRCPBALMU",INVPT)) Q:'INVPT S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPBALMU",INVPT,ITEMDA)) Q:'ITEMDA D
. S RECORD=0,QTY=0 F S RECORD=$O(^TMP($J,"PRCPBALMU",INVPT,ITEMDA,RECORD)) Q:'RECORD S QTY=$S('$G(PRCPFSCA):^(RECORD),1:QTY+^(RECORD))
. K PRCPBALM
. S PRCPBALM("I")=INVPT,PRCPBALM("ITEM")=ITEMDA
. I PRCPTYPE="U" S PRCPBALM("QTY")=-QTY,PRCPBALM("COM")="Barcode Usage",PRCPBALM("TYP")="U"
. I PRCPTYPE="P" S PRCPBALM("QTY")=QTY-$P($G(^PRCP(445,INVPT,1,ITEMDA,0)),"^",7),PRCPBALM("COM")="Barcode Physical Count",PRCPBALM("TYP")="P"
. L +^PRCP(445,INVPT,1,ITEMDA,0)
. S %=$$UPDATE^PRCPUSA(.PRCPBALM)
. L -^PRCP(445,INVPT,1,ITEMDA,0)
. I %="" S RECORD=0 F S RECORD=$O(^TMP($J,"PRCPBALMU",INVPT,ITEMDA,RECORD)) Q:'RECORD S %=$G(^PRCT(446.4,PRCTDA,2,PRCTDA1,1,RECORD,0)) I %'="" S ^(0)="*"_%
;
D NOW^%DTC S Y=% D DD^%DT S $P(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="FINISHED ON "_Y
K VALMBCK
; ask to purge
K X S X(1)="NOTE: You should PURGE all barcode uploads that have been loaded. This will keep the database clean and prevent the barcode upload from being posted to the inventory points more than once."
D DISPLAY^PRCPUX2(5,75,.X)
S XP="Do you want to PURGE this upload entry",XH="Enter 'YES' to purge the entry, 'NO' or '^' to exit."
W ! S %=$$YN^PRCPUYN(1) I '% Q
I %=1 S DA(1)=PRCTDA,DA=PRCTDA1,DIK="^PRCT(446.4,"_PRCTDA_",2," D ^DIK
D AUTOGEN^PRCPBAL2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPBAL1 2877 printed Dec 13, 2024@02:12:59 Page 2
PRCPBAL1 ;WISC/RFJ-process barcode data ;04 Dec 92
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
EEITEMS ; called from protocol file to enter/edit invpt items
+1 DO FULL^VALM1
+2 NEW PRC,PRCP
+3 DO ^PRCPEILM
+4 DO BUILD^PRCPBALB
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;
EDITQTY ; called from protocol file to edit quantities
+1 DO FULL^VALM1
+2 NEW %,D0,DA,DI,DIC,DIE,DQ,DR,I,J,X,Y
+3 SET (DIC,DIE)="^PRCT(446.4,"_PRCTDA_",2,"
SET DA(1)=PRCTDA
SET DA=PRCTDA1
SET DR=1
+4 DO ^DIE
+5 DO BUILD^PRCPBALB
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
+9 ;
POST ; called from protocol file to post quantities
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 NEW %,%H,%I,DA,DIC,DIK,INVPT,ITEMDA,QTY,RECORD,PRCPBALM
+4 SET XP="*** ARE YOU SURE ***"
SET XP(1)="YOU WANT TO UPDATE ON HAND BALANCES IN BARCODED INVENTORY POINTS"
SET XH="ENTER 'YES' TO UPDATE THE QUANTITIES IN THE INVENTORY POINTS."
+5 WRITE !
IF $$YN^PRCPUYN(2)'=1
QUIT
+6 ;
+7 IF $GET(PRCPFSCA)
Begin DoDot:1
+8 KILL X
SET X(1)="Some of the items to upload have been scanned more than once. You have the option to: 1) Upload the LAST SCAN of the item only; or 2) ADD THE QUANTITIES together for all scans of the item."
DO DISPLAY^PRCPUX2(5,75,.X)
+9 SET XP="Do you want to ADD THE QUANTITIES TOGETHER"
SET XH="Enter YES to add the quantities together,"
SET XH(1)=" NO to only upload the last scan of the item, or ^ to exit."
+10 SET %=$$YN^PRCPUYN(2)
SET PRCPFSCA=$SELECT(%=1:1,1:0)
End DoDot:1
if %<1
QUIT
+11 ;
+12 SET INVPT=0
FOR
SET INVPT=$ORDER(^TMP($JOB,"PRCPBALMU",INVPT))
if 'INVPT
QUIT
SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^TMP($JOB,"PRCPBALMU",INVPT,ITEMDA))
if 'ITEMDA
QUIT
Begin DoDot:1
+13 SET RECORD=0
SET QTY=0
FOR
SET RECORD=$ORDER(^TMP($JOB,"PRCPBALMU",INVPT,ITEMDA,RECORD))
if 'RECORD
QUIT
SET QTY=$SELECT('$GET(PRCPFSCA):^(RECORD),1:QTY+^(RECORD))
+14 KILL PRCPBALM
+15 SET PRCPBALM("I")=INVPT
SET PRCPBALM("ITEM")=ITEMDA
+16 IF PRCPTYPE="U"
SET PRCPBALM("QTY")=-QTY
SET PRCPBALM("COM")="Barcode Usage"
SET PRCPBALM("TYP")="U"
+17 IF PRCPTYPE="P"
SET PRCPBALM("QTY")=QTY-$PIECE($GET(^PRCP(445,INVPT,1,ITEMDA,0)),"^",7)
SET PRCPBALM("COM")="Barcode Physical Count"
SET PRCPBALM("TYP")="P"
+18 LOCK +^PRCP(445,INVPT,1,ITEMDA,0)
+19 SET %=$$UPDATE^PRCPUSA(.PRCPBALM)
+20 LOCK -^PRCP(445,INVPT,1,ITEMDA,0)
+21 IF %=""
SET RECORD=0
FOR
SET RECORD=$ORDER(^TMP($JOB,"PRCPBALMU",INVPT,ITEMDA,RECORD))
if 'RECORD
QUIT
SET %=$GET(^PRCT(446.4,PRCTDA,2,PRCTDA1,1,RECORD,0))
IF %'=""
SET ^(0)="*"_%
End DoDot:1
+22 ;
+23 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET $PIECE(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="FINISHED ON "_Y
+24 KILL VALMBCK
+25 ; ask to purge
+26 KILL X
SET X(1)="NOTE: You should PURGE all barcode uploads that have been loaded. This will keep the database clean and prevent the barcode upload from being posted to the inventory points more than once."
+27 DO DISPLAY^PRCPUX2(5,75,.X)
+28 SET XP="Do you want to PURGE this upload entry"
SET XH="Enter 'YES' to purge the entry, 'NO' or '^' to exit."
+29 WRITE !
SET %=$$YN^PRCPUYN(1)
IF '%
QUIT
+30 IF %=1
SET DA(1)=PRCTDA
SET DA=PRCTDA1
SET DIK="^PRCT(446.4,"_PRCTDA_",2,"
DO ^DIK
+31 DO AUTOGEN^PRCPBAL2
+32 QUIT
