source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPHLM0.m@ 802

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1PRCPHLM0 ;WISC/CC - NOTIFY USERS OF HL7 TRANSACTION PROBLEMS; 4/00
2V ;;5.1;IFCAP;**1**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ERR(NUMBER,BULLETIN,SECID,PARAM,HLTXN,PRCPHL) ;
6 ;
7 ; NUMBER = error code
8 ; BULLETIN = Specifies the bulletin to send to users
9 ; SECID = ien of secondary inventory point
10 ; PRARAM = array of values extracted from the HL7 transaction
11 ; HLTXN = ien of ^HLMA and of ^HL(772)
12 ; PRCPHL = array of HL7 segments in message (not always present)
13 ;
14 N ERR,LNCNT,ITEM,MES,PRCPXMY
15 S ERR=NUMBER,LNCNT=0
16 K ^TMP($J,"PRCPHL7")
17 S MES="HL7 transaction #"_HLTXN_" has "
18 F LNCNT=2,3 S ^TMP($J,"PRCPHL7",1,LNCNT,0)=" "
19 I +ERR=1 D ; bad message
20 . I ERR="1A" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"missing or unexpected segments."
21 . I ERR="1B" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"the wrong message type."
22 . I ERR="1C" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"a bad order control code in ORC."
23 . I ERR="1D" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"a bad order control code/activity."
24 . I ERR="1E" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"bad values in the QRD fields."
25 . I ERR="1F" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"an indication that the supply station could not respond."
26 I +ERR=2 D ; bad order number
27 . I ERR="2A" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"an order not in GIP or primary is unknown."
28 . I ERR="2A" S ^TMP($J,"PRCPHL7",1,2,0)="Please remove this order from the supply station."
29 . I ERR="2B" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"activity on a posted order."
30 . I ERR="2C" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"order activity rejected by GIP."
31 . I ERR="2C" S ^TMP($J,"PRCPHL7",1,2,0)="All Posting activity for this order must be done on GIP."
32 . I ERR="2D" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"no order number."
33 I +ERR=3 D ; bad secondary inventory point
34 . I ERR="3A" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"an inventory point not in GIP."
35 . I ERR="3B" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"an IP that is not a secondary."
36 . I ERR="3C" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"a secondary IP not in the order."
37 . I ERR="3D" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"an invalid site specified."
38 . I ERR="3E" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"no station specified."
39 . I ERR="3F" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"a non-supply station IP."
40 I +ERR=4 D ; bad quantity received
41 . S ^TMP($J,"PRCPHL7",1,1,0)=MES_"an excessive quantity transacted."
42 I +ERR=5 D ; bad quantity remaining
43 . S ^TMP($J,"PRCPHL7",1,1,0)=MES_"an excessive quantity remaining."
44 I +ERR=6 D ; bad item
45 . I ERR="6A" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"an item not in the order."
46 . I ERR="6B" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"an item not in the primary."
47 . I ERR="6C" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"an item not in the secondary."
48 . I ERR="6D" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"a non-supply station item."
49 . I ERR="6E" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"an invalid item."
50 . I ERR="6F" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"no item information."
51 . I ERR="6G" S ^TMP($J,"PRCPHL7",1,1,0)=MES_"a case cart or instrument kit item."
52 . S ^TMP($J,"PRCPHL7",1,2,0)="item# "_PARAM("ITEM")_" "_PARAM("NAME")
53 ;
54 I $P(HLTXN,".",3)=447 D ; error encountered processing ^PRCP(447.1)
55 . I BULLETIN="PRCP_BAD_ORDER" D
56 . . I PARAM("TYPE")="FU" S ^TMP($J,"PRCPHL7",1,2,0)="Message indicating receipt of all ordered items was not processed."
57 . . I PARAM("TYPE")'="FU",ERR'="6F" S ^TMP($J,"PRCPHL7",1,2,0)="Received "_PARAM("QTY")_" unit(s) of item# "_PARAM("ITEM")_" "_PARAM("NAME")
58 . I BULLETIN="PRCP_BAD_ACTIVITY" D
59 . . S ^TMP($J,"PRCPHL7",1,2,0)=PARAM("QTY")_" unit(s) of item# "_PARAM("ITEM")_" "_PARAM("NAME")
60 . . I PARAM("ACTIVITY")="USGE" S I="taken for "_PARAM("RECIPIENT")
61 . . I PARAM("ACTIVITY")="RTRN" S I="returned from "_PARAM("RECIPIENT")
62 . . I PARAM("ACTIVITY")="DISP" S I="disposed of"
63 . . I PARAM("ACTIVITY")="ADJD"!(PARAM("ACTIVITY")="DISP") S I="adjusted out of the inventory"
64 . . I PARAM("ACTIVITY")="ADJI" S I="adjusted into the inventory"
65 . . S ^TMP($J,"PRCPHL7",1,3,0)="was/were "_I_" by "_PARAM("USER")
66 ;
67 I +ERR>99 D ; error encountered while building ^PRCP(447.1)
68 . S ^TMP($J,"PRCPHL7",1,1,0)="GIP can't create a new record for HL7 transaction# "_HLTXN
69 . S ^TMP($J,"PRCPHL7",1,2,0)="Contact your IRM if GIP continues to have trouble creating records."
70 . I BULLETIN="PRCP_BAD_ORDER" D
71 . . I PARAM("TYPE")="FU" S ^TMP($J,"PRCPHL7",1,3,0)="Message indicating receipt of all ordered items was not processed."
72 . . I PARAM("TYPE")'="FU" S ^TMP($J,"PRCPHL7",1,3,0)="Received "_PARAM("QTY")_" unit(s) of item# "_PARAM("ITEM")_" "_PARAM("NAME")
73 . . S ^TMP($J,"PRCPHL7",1,4,0)="Please adjust the GIP to show this information."
74 . . S ^TMP($J,"PRCPHL7",1,5,0)=" "
75 . I BULLETIN="PRCP_BAD_ACTIVITY" D
76 . . S ^TMP($J,"PRCPHL7",1,3,0)=PARAM("QTY")_" unit(s) of item# "_PARAM("ITEM")_" "_PARAM("NAME")
77 . . I PARAM("ACTIVITY")="USGE" S I="taken for "_PARAM("RECIPIENT")
78 . . I PARAM("ACTIVITY")="RTRN" S I="returned from "_PARAM("RECIPIENT")
79 . . I PARAM("ACTIVITY")="DISP" S I="disposed of"
80 . . I PARAM("ACTIVITY")="ADJD"!(PARAM("ACTIVITY")="DISP") S I="adjusted out of the inventory"
81 . . I PARAM("ACTIVITY")="ADJI" S I="adjusted into the inventory"
82 . . S ^TMP($J,"PRCPHL7",1,4,0)="was/were "_I_" by "_PARAM("USER")
83 . . S ^TMP($J,"PRCPHL7",1,5,0)="Please adjust the GIP to show this information."
84 . . S ^TMP($J,"PRCPHL7",1,6,0)=" "
85 . . S LNCNT=6
86 S LNCNT=3,I=0
87 I ERR>99 D
88 . I BULLETIN="PRCP_BAD_ACTIVITY" S LNCNT=6
89 . I BULLETIN="PRCP_BAD_ORDER" S LNCNT=5
90 I $D(PRCPHL) F S I=$O(PRCPHL(I)) Q:I']"" D
91 . S LNCNT=LNCNT+1,^TMP($J,"PRCPHL7",1,LNCNT,0)=PRCPHL(I)
92 I $D(PRCPHL),HLQUIT>0 F X HLNEXT Q:HLQUIT'>0 D
93 . S LNCNT=LNCNT+1,^TMP($J,"PRCPHL7",1,LNCNT,0)=HLNODE
94 S ^TMP($J,"PRCPHL7",1,0)=LNCNT
95 I SECID D BLDLIST I $O(XMY(0))]"" D SEND
96 I 'SECID D
97 . N SS
98 . S SECID=0,SS=0
99 . F S SS=$O(^PRCP(445,"AI",SS)) Q:'+SS D
100 . . S SECID=$O(^PRCP(445,"AI",SS,SECID)) Q:'+SECID D BLDLIST
101 . I $O(XMY(0))]"" D SEND
102 K ^TMP($J,"PRCPHL7")
103 Q
104 ;
105 ; build array of message recipients
106BLDLIST D GETUSER^PRCPXTRM(SECID) Q:'$O(PRCPXMY("")) ; inventory point users
107 S ITEM=0
108 ; restrict to managers
109 F S ITEM=$O(PRCPXMY(ITEM)) Q:ITEM'>0 I PRCPXMY(ITEM)=1 S XMY(ITEM)=""
110 Q
111 ;
112SEND S XMTEXT="^TMP($J,""PRCPHL7"",1,"
113 S XMB=BULLETIN
114 I XMB="PRCP_BAD_ORDER" D
115 . S XMB(1)=PARAM("ORDER")
116 . S XMB(2)=PARAM("SIPNAME")
117 I XMB="PRCP_BAD_ACTIVITY" D
118 . S XMB(1)=PARAM("SIPNAME")
119 . S XMB(2)=PARAM("ITEM")
120 . S XMB(3)=PARAM("ACTIVITY")
121 I XMB="PRCP_BAD_QUERY" D
122 . S XMB(1)=PARAM("SIPNAME")
123 S XMDUZ="SUPPLY STATION INTERFACE"
124 D EN^XMB
125 Q
Note: See TracBrowser for help on using the repository browser.