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