source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPSMB0.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1PRCPSMB0 ;WISC/RFJ-isms transaction: balance update ;25 Oct 91
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 D ^PRCPUSEL Q:'$G(PRCP("I"))
5 I PRCP("DPTYPE")'="W" W !,"THIS OPTION SHOULD ONLY BE USED BY THE WAREHOUSE INVENTORY POINT." Q
6 ;I $$ISMSFLAG^PRCPUX2(PRC("SITE"))'=2 W !,"YOU NEED TO TURN THE ISMS SWITCH 'ON' BEFORE YOU CAN USE THIS OPTION." Q
7 N %,CODESHT,COUNT,DESCR,ITEMDA,PRCPFLAG,PRCPXMZ,ZTSK
8 S IOP="HOME" D ^%ZIS K IOP D Q
9 W !!,"To select ALL items, press RETURN."
10 F S ITEMDA=$$ITEM^PRCPUITM(PRCP("I"),0,"","") Q:'ITEMDA D
11 . S CODESHT=$$BALANCE^PRCPSMB1(PRCP("I"),ITEMDA) I $E(CODESHT,1,2)'="BU" W !?5,CODESHT Q
12 . S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)
13 . W @IOF,!!,"I WILL TRANSMIT THE FOLLOWING BALANCES TO ISMS:"
14 . W !,ITEMDA,?7,$E(DESCR,1,50),?60,$P(CODESHT,"^",2),!!?5,"ISSUE UNIT",?23,": ",$P(CODESHT,"^",3),!?5,"QUANTITY ON-HAND",?23,": ",$P(CODESHT,"^",4)/100
15 . W !?5,"ON-HAND VALUE",?23,": ",$J(+$P(CODESHT,"^",5)/100,0,2),!?5,"QUANTITY DUE-OUT",?23,": ",+$P(CODESHT,"^",6)/100
16 . W !?5,"AVERAGE COST",?23,": ",$J(+$P(CODESHT,"^",7)/10000,0,3),!?5,"LAST RECEIPT COST",?23,": ",$J(+$P(CODESHT,"^",8)/10000,0,3),!?5,"LAST SALE COST",?23,": ",$J(+$P(CODESHT,"^",9)/10000,0,3)
17 . W !!?1,"CS: ",CODESHT
18 . S ^TMP($J,"BAL",ITEMDA)=DESCR_"^"_$P(CODESHT,"^",2),^TMP($J,"BAL",ITEMDA,"CS")=CODESHT
19 I ITEMDA["^" D Q Q
20 I '$O(^TMP($J,"BAL",0)) S XP="Do you want to select ALL items",XH="Enter 'YES' to select ALL items, 'NO' or '^' to exit." W ! I $$YN^PRCPUYN(1)=1 D D Q Q
21 . W !!,"I will queue this to run as a background job. When I finish building the",!,"code sheet, I will send you a mailman message with the code sheet number",!,"and items NOT transmitted because of errors found."
22 . S ZTRTN="DQ^PRCPSMB0",ZTIO="",ZTDESC="ISMS Balance Transaction:All Items",ZTSAVE("PRC*")="",ZTSAVE("ZTREQ")="@" D ^%ZTLOAD K ZTSK
23 I '$O(^TMP($J,"BAL",0)) W !,"NO ITEMS SELECTED." D Q Q
24 W @IOF,!,"YOU HAVE SELECTED THE FOLLOWING ITEMS TO UPDATE ISMS BALANCES:" S ITEMDA=0,COUNT=1 F S ITEMDA=$O(^TMP($J,"BAL",ITEMDA)) Q:'ITEMDA!($D(PRCPFLAG)) S %=^(ITEMDA) I %'="",$D(^TMP($J,"BAL",ITEMDA,"CS")) D
25 . W !,ITEMDA,?7,$E($P(%,"^"),1,50),?60,$P(%,"^",2) S ^TMP($J,"STRING",COUNT)=^TMP($J,"BAL",ITEMDA,"CS"),COUNT=COUNT+1
26 . I $Y>(IOSL-5) D P^PRCPUREP
27 I $D(PRCPFLAG) D Q Q
28 I '$O(^TMP($J,"STRING",0)) W !!,"NO CODE SHEETS CREATED." D Q Q
29 S XP="*** ARE YOU SURE YOU WANT TO CREATE THE ISMS TRANSACTION",XP(1)=" AND TRANSMIT IT TO AUSTIN",XH="ENTER 'YES' TO CREATE THE ISMS TRANSACTION AND TRANSMIT IT TO AUSTIN",XH(1)="ENTER 'NO' OR '^' TO EXIT."
30 W !! I $$YN^PRCPUYN(1)'=1 D Q Q
31 D TRANSMIT^PRCPSMCS(PRC("SITE"),"BAL","","ISM","")
32 W !!?4,"Transmitted in MailMan Messages:" I $D(PRCPXMZ) S %=0 F S %=$O(PRCPXMZ(%)) Q:'% W " ",PRCPXMZ(%)," "
33Q K ^TMP($J,"BAL"),^TMP($J,"STRING"),^TMP($J,"MAIL")
34 Q
35 ;
36 ;
37DQ ; queue comes here to send all items to isms
38 N CODESHT,COUNT,ITEMDA,LINE,PRCPCS,XMDUZ,XMSUB,XMTEXT,XMY
39 K ^TMP($J,"MAIL"),^TMP($J,"STRING")
40 S COUNT=1,LINE=5,ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA D
41 . L +^PRCP(445,PRCP("I"),1,ITEMDA)
42 . S CODESHT=$$BALANCE^PRCPSMB1(PRCP("I"),ITEMDA)
43 . I $E(CODESHT,1,2)'="BU" D Q
44 . . S ^TMP($J,"MAIL",LINE)="ITEM # "_ITEMDA_$E(" ",$L(ITEMDA),8)_$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,50),LINE=LINE+1
45 . . S ^TMP($J,"MAIL",LINE)=" "_CODESHT,LINE=LINE+1
46 . S ^TMP($J,"STRING",COUNT)=CODESHT,COUNT=COUNT+1
47 . L -^PRCP(445,PRCP("I"),1,ITEMDA)
48 ;
49 ; create mailman messages
50 K PRCPXMZ I COUNT>1 D TRANSMIT^PRCPSMCS(PRC("SITE"),"BAL","","ISM","")
51 S ^TMP($J,"MAIL",1)="ISMS BALANCE UPDATE TRANSACTION (IM-6): ALL ITEMS SELECTED"
52 S ^TMP($J,"MAIL",2)=$S('$D(PRCPXMZ):" *** BALANCE UPDATE TRANSACTION WAS NOT CREATED AND TRANSMITTED TO ISMS ***",1:" MAILMAN MESSAGE(S):")
53 I $D(PRCPXMZ) S %=0 F S %=$O(PRCPXMZ(%)) Q:'% S ^(2)=^TMP($J,"MAIL",2)_" "_+PRCPXMZ(%)
54 S ^TMP($J,"MAIL",3)="",^(4)=$S(LINE=5:"ALL INVENTORY ITEM BALANCES HAVE BEEN TRANSMITTED TO ISMS.",1:"THE FOLLOWING ITEMS DID NOT HAVE THEIR BALANCES TRANSMITTED TO ISMS:")
55 S XMSUB="ISMS BALANCE UPDATE TRANSACTION",XMTEXT="^TMP($J,""MAIL"",",XMDUZ=DUZ,XMY(DUZ)="" D ^XMD
56 D Q Q
57 ;
58 ;
59TASKMAN ; taskman comes here to transmit all balances in the background
60 S PRCP("I")=0 F S PRCP("I")=$O(^PRCP(445,"AC","W",PRCP("I"))) Q:'PRCP("I") S PRC("SITE")=+$G(^PRCP(445,PRCP("I"),0)) I PRC("SITE") D DQ
61 Q
Note: See TracBrowser for help on using the repository browser.