source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPHL70.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.7 KB
Line 
1PRCPHL70 ;WISC/CC-PROCESS QUEUED INCOMING ORDERS ;4/00
2V ;;5.1;IFCAP;**1,24**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6 ;
7 ; background job to process 447.1 entries sequentially by IP
8 ; kicked off by TASKMAN option PRCP2 SUPPLY STATION TXN RUN
9 ;
10NEWMSG L +^PRCP(447.1,"PROCESS QUEUE"):3 I $T=0 Q
11 N DA,DIC,DIE,DIK,DR,PRCPDA,PRCPDONE,PRCPMGTP,PRCPSEC,PRCPSIT,X
12 ;
13START S PRCPSIT=0
14 ;
15 ; for each site/station
16 F S PRCPSIT=$O(^PRCP(447.1,"C",PRCPSIT)) Q:'+PRCPSIT D
17 . S PRCPSEC=0
18 . ;
19 . ; for each inventory point at that site/station
20 . F S PRCPSEC=$O(^PRCP(447.1,"C",PRCPSIT,PRCPSEC)) Q:'+PRCPSEC D
21 . . S PRCPDA=0,PRCPDONE=0
22 . . L +^PRCP(445,PRCPSEC,1):3 I $T=0 Q ; lock inventory point items
23 . . D ADD^PRCPULOC(445,PRCPSEC_"-1",0,"HL7 Transaction Processing")
24 . . ;
25 . . ; process each supply station transaction sequentially
26 . . F S PRCPDA=$O(^PRCP(447.1,"C",PRCPSIT,PRCPSEC,PRCPDA)) Q:'+PRCPDA D I 'PRCPDONE Q ; If not processed sucessfully, don't get next txn
27 . . . S PRCPMGTP=$P(^PRCP(447.1,PRCPDA,0),"^",5)
28 . . . L +^PRCP(447.1,PRCPDA):3 I $T=0 Q ; lock file 447.1 entry
29 . . . ;
30 . . . ; Quantity on hand queries (OSR^Q06 messages)
31 . . . I $E(PRCPMGTP,1,3)="OSR" D
32 . . . . L +^PRCP(445,PRCPSEC,6):1 I $T=0 Q
33 . . . . D ADD^PRCPULOC(445,PRCPSEC_"-6",0,"HL7 Transaction Processing")
34 . . . . D GETMSG^PRCPHLQU(PRCPDA,.PRCPDONE)
35 . . . . L -^PRCP(445,PRCPSEC,6)
36 . . . . D CLEAR^PRCPULOC(445,PRCPSEC_"-6",0)
37 . . . . Q
38 . . . ;
39 . . . ; Order refill/complete (ORM^O01 messages)
40 . . . I $E(PRCPMGTP,1,3)="ORM" D PROCESS^PRCPHLPO(PRCPDA,.PRCPDONE)
41 . . . ;
42 . . . ; Item Utilization/Adjustments (RAS^O01 messages)
43 . . . I $E(PRCPMGTP,1,3)="RAS" D PROCESS^PRCPHLUT(PRCPDA,.PRCPDONE)
44 . . . ;
45 . . . ; maintain 447.1
46 . . . I PRCPDONE D ; processed successfully, kill entry
47 . . . . S DA=PRCPDA,DIK="^PRCP(447.1," D ^DIK
48 . . . ;
49 . . . L -^PRCP(447.1,PRCPDA)
50 . . ;
51 . . L -^PRCP(445,PRCPSEC,1)
52 . . D CLEAR^PRCPULOC(445,PRCPSEC_"-1",0)
53 ;
54Q I $O(^PRCP(447.1,0))]"" G START ; loop until queue is empty
55 L -^PRCP(447.1,"PROCESS QUEUE")
56 Q
57 ;
58 ;
59NAME(PRCPSEC,ITEM,NAME,TYPE,PRCPHL7) ; notify users of name mismatches
60 ;
61 ; PRCPSEC secondary inventory point ien
62 ; ITEM item's ien
63 ; NAME item name as it appears on the supply station
64 ; TYPE supply station approach to item names
65 ; O = only 1 name per item per system
66 ; S = each station may have different name for same item
67 ; PRCPHL7 (file 773 IEN).(file 772 IEN).447.1 for the HL7 transaction
68 ;
69 N PRCPXMY,USER,XMB,XMDUZ,XMTEXT
70 S ^TMP($J,"PRCPHL7",1,1,0)=" " ; blank line
71 I TYPE="S" S ^TMP($J,"PRCPHL7",1,2,0)="ON GIP: "_$P($G(^PRCP(445,PRCPSEC,1,ITEM,6)),"^",1)
72 I TYPE="O" S ^TMP($J,"PRCPHL7",1,2,0)="ON GIP: "_$P($G(^PRC(441,ITEM,0)),"^",2)
73 S ^TMP($J,"PRCPHL7",1,3,0)="STATION: "_NAME
74 S ^TMP($J,"PRCPHL7",1,4,0)=""
75 S ^TMP($J,"PRCPHL7",1,5,0)=""
76 I PRCPHL7 S ^TMP($J,"PRCPHL7",1,5,0)="(Information acquired from HL7 txn# "_PRCPHL7_")"
77 S ^TMP($J,"PRCPHL7",1)=5
78 D GETUSER^PRCPXTRM(PRCPSEC) Q:'$O(PRCPXMY("")) ; send message to primary inventory point users
79 S USER=0
80 ; restrict message to managers
81 F S USER=$O(PRCPXMY(USER)) Q:USER'>0 I PRCPXMY(USER)=1 S XMY(USER)=""
82 S XMTEXT="^TMP($J,""PRCPHL7"",1,"
83 S XMB(1)=$$INVNAME^PRCPUX1(PRCPSEC)
84 S XMB(2)=ITEM
85 S XMB="PRCP_ITEM_NAME"
86 S XMDUZ="SUPPLY STATION INTERFACE"
87 D EN^XMB
88 K ^TMP($J,"PRCPHL7")
89 Q
90 ;
91 ;
92QTYDISC(PRCPSEC,PRCPITEM,PRCPITNM,QTY,PRCPLEFT,PRCPHL7) ; tell user qty left is wrong
93 ;
94 ; PRCPSEC = the secondary IP ien
95 ; PRCPITEM = the item ien
96 ; PRCPITNM = the item name from the transaction
97 ; QTY = the actual quantity in GIP after this transaction
98 ; PRCPLEFT = the quantity on the supply station after this transaction
99 ; PRCPHL7 = (file 773 IEN).(file 772 IEN).447.1 for the HL7 transaction
100 ;
101 N ITEM,PRCPXMY,REFILL,XMB,XMDUZ,XMTEXT,XMY
102 D GETUSER^PRCPXTRM(PRCPSEC) Q:'$O(PRCPXMY("")) ; quit if no users in inv point
103 S ITEM=0
104 ; restrict message to managers
105 F S ITEM=$O(PRCPXMY(ITEM)) Q:ITEM'>0 I PRCPXMY(ITEM)=1 S XMY(ITEM)=""
106 K ^TMP($J,"PRCPHL7")
107 S XMTEXT="^TMP($J,""PRCPHL7"",1,"
108 S REFILL=$$REFILLS^PRCPRDIS(PRCPITEM,PRCPSEC) I REFILL]"" D
109 . S ^TMP($J,"PRCPHL7",1,1,0)=" "
110 . S ^TMP($J,"PRCPHL7",1,2,0)=" "
111 . S ^TMP($J,"PRCPHL7",1,3,0)="NOTE: This item has "_$P(REFILL,":",1)_" on:"
112 . S ^TMP($J,"PRCPHL7",1,4,0)=$P(REFILL,":",2)
113 . S ^TMP($J,"PRCPHL7",1)=4
114 S XMB="PRCP_QTY_MISMATCH"
115 S XMB(1)=$$INVNAME^PRCPUX1(PRCPSEC)
116 S XMB(2)=PRCPITNM_" ("_PRCPITEM_")"
117 S XMB(3)=QTY
118 S XMB(4)=PRCPLEFT
119 S XMB(5)=PRCPHL7
120 S XMDUZ="SUPPLY STATION INTERFACE"
121 D EN^XMB
122 K ^TMP($J,"PRCPHL7")
123 Q
124 ;
125 ;
126 ; cleans out file 447.1 - not invoked by any routine or option
127CLEAN N A,DA,DIK
128 S A=0
129 S DIK="^PRCP(447.1,"
130 F S A=$O(^PRCP(447.1,A)) Q:'+A S DA=A D ^DIK
131 Q
Note: See TracBrowser for help on using the repository browser.