- 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 Mar 13, 2025@21:18:40 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
