- INHUTC51 ;KN,bar; 18 Jun 99 14:44; Interface Message/Error Search
- ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- ;COPYRIGHT 1991-2000 SAIC
- ;;COPYRIGHT 1997 SAIC
- ;
- ; Interface Message/Error Search Part II (INHUTC5)
- ; This sub-module contains functions FIND, MSGTEST, and ERRTEST.
- Q
- ;
- MSGTEST(INFND,INMIEN,INSRCH) ; Add matching message to array
- ;
- ; Description: Used to test a transaction in ^INTHU to
- ; values passed in INSRCH parameter.
- ; Parameters:
- ; INFND = Flag indicates status of the test (returned)
- ; 1 = match found
- ; 0 = no match
- ; INMIEN = IEN into ^INTHU
- ; INSRCH = The array contains search criteria
- ;
- N INMSG0,INMAXSZ,INFLAGZ
- S INFND=0,INMSG0=$G(^INTHU(INMIEN,0))
- ; Test single and multiple values of the Original Transaction type
- I $D(INSRCH("INORIG")) Q:$P(INMSG0,U,11)'=INSRCH("INORIG")
- I $D(INSRCH("MULTIORIG")) S INQ=0 D Q:'INQ
- .S X=0 F S X=$O(INSRCH("MULTIORIG",X)) Q:'X I $P(INMSG0,U,11)=X S INQ=1 Q
- ; Test single and multiple values of the Destination
- I $D(INSRCH("INDEST")) Q:$P(INMSG0,U,2)'=INSRCH("INDEST")
- I $D(INSRCH("MULTIDEST")) S INQ=0 D Q:'INQ
- .S X=0 F S X=$O(INSRCH("MULTIDEST",X)) Q:'X I $P(INMSG0,U,2)=X S INQ=1 Q
- ; Test single and multiple values of the Status
- I $D(INSRCH("INSTAT")) Q:$P(INMSG0,U,3)'=INSRCH("INSTAT")
- I $D(INSRCH("MULTISTAT")) S INQ=0 D Q:'INQ
- .S X="" F S X=$O(INSRCH("MULTISTAT",X)) Q:'$L(X) I $P(INMSG0,U,3)=X S INQ=1 Q
- ; Test single and multiple values of the Division
- I $D(INSRCH("INDIV")) Q:$P(INMSG0,U,21)'=INSRCH("INDIV")
- I $D(INSRCH("MULTIDIV")) S INQ=0 D Q:'INQ
- .S X=0 F S X=$O(INSRCH("MULTIDIV",X)) Q:'X I $P(INMSG0,U,21)=X S INQ=1 Q
- ; Test single value of the message ID, Source, User, Patient and Message Text
- I $D(INSRCH("INID")) Q:$P(INMSG0,U,5)'=INSRCH("INID")
- I $D(INSRCH("INDIR")) Q:$P(INMSG0,U,10)'=INSRCH("INDIR")
- I $D(INSRCH("INSOURCE")) Q:$E($P(INMSG0,U,8),1,$L(INSRCH("INSOURCE")))'=INSRCH("INSOURCE")
- I $D(INSRCH("INUSER")) Q:$P(INMSG0,U,15)'=INSRCH("INUSER")
- I $D(INSRCH("INPAT")) Q:'$$INMSPAT^INHMS1(INMIEN,INSRCH("INPAT"))
- I $D(INSRCH("INTEXT"))>9 Q:'$$INMSRCH^INHMS1(.INSRCH,INMIEN,INSRCH("INTYPE"))
- S INFND=1
- Q
- ;
- ERRTEST(INFND,INEIEN,INSRCH) ; Test for error matching criteria
- ;
- ; Description: The function ERRTEST is used to test the error record
- ; in ^INTHER (which pointed by INEIEN) for error to
- ; values passed in INSRCH parameter.
- ; Parameters:
- ; INFND = Flag indicates status of the test (returned)
- ; 1 = match found
- ; 0 = no match
- ; INEIEN = IEN into ^INTHER
- ; INSRCH = The array contains search criteria
- ;
- N INERR0,INMSG0,INMAXSZ,INMIEN
- S INFND=0,INERR0=$G(^INTHER(INEIEN,0))
- S INMIEN=$P(INERR0,U,4),INMSG0=$G(^INTHU(+INMIEN,0))
- Q:'INMIEN&$D(INSRCH("MESSAGEREQ"))
- ; Checking the Interface Error File
- ; Test single and multiple values of the Original Transaction type
- I $D(INSRCH("INORIG")) I $P(INERR0,U,2)'=INSRCH("INORIG"),($P(INMSG0,U,11)'=INSRCH("INORIG")) Q
- I $D(INSRCH("MULTIORIG")) S INQ=0 D Q:'INQ
- . S X=0 F S X=$O(INSRCH("MULTIORIG",X)) Q:'X I ($P(INERR0,U,2)=X)!($P(INMSG0,U,11)=X) S INQ=1 Q
- ; Test single and multiple values of the Destination
- I $D(INSRCH("INDEST")) I $P(INERR0,U,9)'=INSRCH("INDEST"),($P(INMSG0,U,2)'=INSRCH("INDEST")) Q
- I $D(INSRCH("MULTIDEST")) S INQ=0 D Q:'INQ
- . S X=0 F S X=$O(INSRCH("MULTIDEST",X)) Q:'X I ($P(INERR0,U,9)=X)!($P(INMSG0,U,2)=X) S INQ=1 Q
- ; Test single and multiple values of the Status
- I $D(INSRCH("INSTAT")) Q:$P(INMSG0,U,3)'=INSRCH("INSTAT")
- I $D(INSRCH("MULTISTAT")) S INQ=0 D Q:'INQ
- . S X="" F S X=$O(INSRCH("MULTISTAT",X)) Q:'$L(X) I ($P(INMSG0,U,3)=X) S INQ=1 Q
- ; Test single and multiple values of the Division
- I $D(INSRCH("INDIV")) Q:$P(INMSG0,U,21)'=INSRCH("INDIV")
- I $D(INSRCH("MULTIDIV")) S INQ=0 D Q:'INQ
- . S X=0 F S X=$O(INSRCH("MULTIDIV",X)) Q:'X I ($P(INMSG0,U,21)=X) S INQ=1 Q
- ; Test value of the Error Location, Error Resolution Status and Error Text to search
- I $D(INSRCH("INERLOC")) Q:$P(INERR0,U,5)'=INSRCH("INERLOC")
- I $D(INSRCH("INERSTAT")) Q:$P(INERR0,U,10)'=INSRCH("INERSTAT")
- I $D(INSRCH("INTEXT"))>9 Q:'$$INERSRCH^INHERR1(.INSRCH,INEIEN,INSRCH("INTYPE"))
- ; Checking the Interface Message file
- ; Test value of the Message Start Date and Message End Date
- I $D(INSRCH("INMSGSTART")) Q:($P(INMSG0,U)<INSRCH("INMSGSTART"))
- I $D(INSRCH("INMSGEND")) Q:($P(INMSG0,U)>INSRCH("INMSGEND"))
- ; Test value of the Message ID, Direction, User, Source and Patient
- I $D(INSRCH("INID")) Q:$P(INMSG0,U,5)'=INSRCH("INID")
- I $D(INSRCH("INDIR")) Q:$P(INMSG0,U,10)'=INSRCH("INDIR")
- I $D(INSRCH("INSOURCE")) Q:$E($P(INMSG0,U,8),1,$L(INSRCH("INSOURCE")))'=INSRCH("INSOURCE")
- I $D(INSRCH("INUSER")) Q:($P(INMSG0,U,15)'=INSRCH("INUSER"))&($P(INERR0,U,8)'=INSRCH("INUSER"))
- I $D(INSRCH("INPAT")) Q:'INMIEN Q:'$$INMSPAT^INHMS1(INMIEN,INSRCH("INPAT"))
- S INFND=1
- Q
- ;
- MSGSTD(INIEN) ; return the message standard for a given entry in the UIF
- ;
- ; INIEN = IEN into ^INTHU
- ;
- N INMSG0,INORIGTT,INREP,INSCR
- S INIEN=$G(INIEN) Q:'INIEN ""
- S INMSG0=$G(^INTHU(INIEN,0)) Q:'$L(INMSG0) ""
- ; if incoming message, the parent message field points to the
- ; outgoing message
- I $P(INMSG0,U,10)="I" D Q:'$L(INMSG0)!('INIEN) ""
- . S INIEN=$P(INMSG0,U,7) Q:'INIEN
- . S INMSG0=$G(^INTHU(INIEN,0))
- S INORIGTT=$P(INMSG0,U,11) Q:'INORIGTT ""
- S INSCR=$P($G(^INRHT(INORIGTT,0)),U,3) I 'INSCR D Q:'INSCR ""
- . ; Special processing for replicated messages, if no script pointer
- . S INREP=$O(^INRHR("B",INORIGTT,"")) Q:'INREP
- . S INORIGTT=$P($G(^INRHR(INREP,0)),U,2) Q:'INORIGTT
- . S INSCR=$P($G(^INRHT(INORIGTT,0)),U,3)
- Q $P($G(^INRHS(INSCR,0)),U,7)
- ;
- INNCPAT(INIEN,INPAT,INPATNA) ; Test msg. for a NCPDP patient match
- ;
- ; MODULE NAME: INNCPAT (Interface Message PATIENT Search for NCPDP msg)
- ; DESCRIPTION: Search ^INTHU( INIEN ) Pharm. claim message for matching
- ; values to the string: INPAT. Using CHCS patient IEN for
- ; outbound messages, and Pharmacy Prescription Number.
- ; RETURN = PASS/FAIL (1/0) and patient found set in INPATNAM
- ; PARAMETERS:
- ; INIEN = The IEN of the message in the ^INTHU message file
- ; INPAT = The patients internal IEN from the ^DPT file
- ; INPATNA = The patient name found in the message ("" if none)
- ;
- S INIEN=$G(INIEN),INPAT=+$G(INPAT),INPATNAM=$G(INPATNA)
- Q:'INIEN 0
- N INBLDCT,INBLDTXT,INRET,INRXNUM
- ; Pharmacy claim message is in line 3
- S INBLDTXT="",INBLDCT=2 D GETLINE^INHOU(INIEN,.INBLDCT,.INBLDTXT)
- Q:'$D(INBLDTXT) 0
- ; prescription number is the first field and is 7 bytes
- S INRXNUM=+$E(INBLDTXT,1,7),INRET=$$NCMATCH(INPAT,INRXNUM),INPATNAM=$P(INRET,U,2)
- Q INRET
- ;
- NCMATCH(INPAT,INRXNUM) ; For a given RX number find a patient match
- ;
- ; Input: INPAT (req) = IEN for the Patient
- ; INRXNUM (req) = Prescription number from the NCPDP message
- ; Output: 1_"^"_Patient IEN, if match found
- ; 0, otherwise
- ;
- N INC0,INCPT,INCOLLEC,INDPT
- S INPAT=$G(INPAT) Q:'INPAT 0
- S INCOLLEC=$O(^PSM(8216,"B",INRXNUM,0)) Q:'INCOLLEC 0
- S INC0=$G(^PSM(8216,INCOLLEC,0)) Q:'$L(INC0) 0
- S INCPT=$P(INC0,U,5) S:INCPT INDPT=$P($G(^DPT(INCPT,0)),U)
- Q:INPAT=INCPT 1_"^"_INDPT
- Q 0
- INHUTC51 ;KN,bar; 18 Jun 99 14:44; Interface Message/Error Search
- +1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- +2 ;COPYRIGHT 1991-2000 SAIC
- +3 ;;COPYRIGHT 1997 SAIC
- +4 ;
- +5 ; Interface Message/Error Search Part II (INHUTC5)
- +6 ; This sub-module contains functions FIND, MSGTEST, and ERRTEST.
- +7 QUIT
- +8 ;
- MSGTEST(INFND,INMIEN,INSRCH) ; Add matching message to array
- +1 ;
- +2 ; Description: Used to test a transaction in ^INTHU to
- +3 ; values passed in INSRCH parameter.
- +4 ; Parameters:
- +5 ; INFND = Flag indicates status of the test (returned)
- +6 ; 1 = match found
- +7 ; 0 = no match
- +8 ; INMIEN = IEN into ^INTHU
- +9 ; INSRCH = The array contains search criteria
- +10 ;
- +11 NEW INMSG0,INMAXSZ,INFLAGZ
- +12 SET INFND=0
- SET INMSG0=$GET(^INTHU(INMIEN,0))
- +13 ; Test single and multiple values of the Original Transaction type
- +14 IF $DATA(INSRCH("INORIG"))
- IF $PIECE(INMSG0,U,11)'=INSRCH("INORIG")
- QUIT
- +15 IF $DATA(INSRCH("MULTIORIG"))
- SET INQ=0
- Begin DoDot:1
- +16 SET X=0
- FOR
- SET X=$ORDER(INSRCH("MULTIORIG",X))
- IF 'X
- QUIT
- IF $PIECE(INMSG0,U,11)=X
- SET INQ=1
- QUIT
- End DoDot:1
- IF 'INQ
- QUIT
- +17 ; Test single and multiple values of the Destination
- +18 IF $DATA(INSRCH("INDEST"))
- IF $PIECE(INMSG0,U,2)'=INSRCH("INDEST")
- QUIT
- +19 IF $DATA(INSRCH("MULTIDEST"))
- SET INQ=0
- Begin DoDot:1
- +20 SET X=0
- FOR
- SET X=$ORDER(INSRCH("MULTIDEST",X))
- IF 'X
- QUIT
- IF $PIECE(INMSG0,U,2)=X
- SET INQ=1
- QUIT
- End DoDot:1
- IF 'INQ
- QUIT
- +21 ; Test single and multiple values of the Status
- +22 IF $DATA(INSRCH("INSTAT"))
- IF $PIECE(INMSG0,U,3)'=INSRCH("INSTAT")
- QUIT
- +23 IF $DATA(INSRCH("MULTISTAT"))
- SET INQ=0
- Begin DoDot:1
- +24 SET X=""
- FOR
- SET X=$ORDER(INSRCH("MULTISTAT",X))
- IF '$LENGTH(X)
- QUIT
- IF $PIECE(INMSG0,U,3)=X
- SET INQ=1
- QUIT
- End DoDot:1
- IF 'INQ
- QUIT
- +25 ; Test single and multiple values of the Division
- +26 IF $DATA(INSRCH("INDIV"))
- IF $PIECE(INMSG0,U,21)'=INSRCH("INDIV")
- QUIT
- +27 IF $DATA(INSRCH("MULTIDIV"))
- SET INQ=0
- Begin DoDot:1
- +28 SET X=0
- FOR
- SET X=$ORDER(INSRCH("MULTIDIV",X))
- IF 'X
- QUIT
- IF $PIECE(INMSG0,U,21)=X
- SET INQ=1
- QUIT
- End DoDot:1
- IF 'INQ
- QUIT
- +29 ; Test single value of the message ID, Source, User, Patient and Message Text
- +30 IF $DATA(INSRCH("INID"))
- IF $PIECE(INMSG0,U,5)'=INSRCH("INID")
- QUIT
- +31 IF $DATA(INSRCH("INDIR"))
- IF $PIECE(INMSG0,U,10)'=INSRCH("INDIR")
- QUIT
- +32 IF $DATA(INSRCH("INSOURCE"))
- IF $EXTRACT($PIECE(INMSG0,U,8),1,$LENGTH(INSRCH("INSOURCE")))'=INSRCH("INSOURCE")
- QUIT
- +33 IF $DATA(INSRCH("INUSER"))
- IF $PIECE(INMSG0,U,15)'=INSRCH("INUSER")
- QUIT
- +34 IF $DATA(INSRCH("INPAT"))
- IF '$$INMSPAT^INHMS1(INMIEN,INSRCH("INPAT"))
- QUIT
- +35 IF $DATA(INSRCH("INTEXT"))>9
- IF '$$INMSRCH^INHMS1(.INSRCH,INMIEN,INSRCH("INTYPE"))
- QUIT
- +36 SET INFND=1
- +37 QUIT
- +38 ;
- ERRTEST(INFND,INEIEN,INSRCH) ; Test for error matching criteria
- +1 ;
- +2 ; Description: The function ERRTEST is used to test the error record
- +3 ; in ^INTHER (which pointed by INEIEN) for error to
- +4 ; values passed in INSRCH parameter.
- +5 ; Parameters:
- +6 ; INFND = Flag indicates status of the test (returned)
- +7 ; 1 = match found
- +8 ; 0 = no match
- +9 ; INEIEN = IEN into ^INTHER
- +10 ; INSRCH = The array contains search criteria
- +11 ;
- +12 NEW INERR0,INMSG0,INMAXSZ,INMIEN
- +13 SET INFND=0
- SET INERR0=$GET(^INTHER(INEIEN,0))
- +14 SET INMIEN=$PIECE(INERR0,U,4)
- SET INMSG0=$GET(^INTHU(+INMIEN,0))
- +15 IF 'INMIEN&$DATA(INSRCH("MESSAGEREQ"))
- QUIT
- +16 ; Checking the Interface Error File
- +17 ; Test single and multiple values of the Original Transaction type
- +18 IF $DATA(INSRCH("INORIG"))
- IF $PIECE(INERR0,U,2)'=INSRCH("INORIG")
- IF ($PIECE(INMSG0,U,11)'=INSRCH("INORIG"))
- QUIT
- +19 IF $DATA(INSRCH("MULTIORIG"))
- SET INQ=0
- Begin DoDot:1
- +20 SET X=0
- FOR
- SET X=$ORDER(INSRCH("MULTIORIG",X))
- IF 'X
- QUIT
- IF ($PIECE(INERR0,U,2)=X)!($PIECE(INMSG0,U,11)=X)
- SET INQ=1
- QUIT
- End DoDot:1
- IF 'INQ
- QUIT
- +21 ; Test single and multiple values of the Destination
- +22 IF $DATA(INSRCH("INDEST"))
- IF $PIECE(INERR0,U,9)'=INSRCH("INDEST")
- IF ($PIECE(INMSG0,U,2)'=INSRCH("INDEST"))
- QUIT
- +23 IF $DATA(INSRCH("MULTIDEST"))
- SET INQ=0
- Begin DoDot:1
- +24 SET X=0
- FOR
- SET X=$ORDER(INSRCH("MULTIDEST",X))
- IF 'X
- QUIT
- IF ($PIECE(INERR0,U,9)=X)!($PIECE(INMSG0,U,2)=X)
- SET INQ=1
- QUIT
- End DoDot:1
- IF 'INQ
- QUIT
- +25 ; Test single and multiple values of the Status
- +26 IF $DATA(INSRCH("INSTAT"))
- IF $PIECE(INMSG0,U,3)'=INSRCH("INSTAT")
- QUIT
- +27 IF $DATA(INSRCH("MULTISTAT"))
- SET INQ=0
- Begin DoDot:1
- +28 SET X=""
- FOR
- SET X=$ORDER(INSRCH("MULTISTAT",X))
- IF '$LENGTH(X)
- QUIT
- IF ($PIECE(INMSG0,U,3)=X)
- SET INQ=1
- QUIT
- End DoDot:1
- IF 'INQ
- QUIT
- +29 ; Test single and multiple values of the Division
- +30 IF $DATA(INSRCH("INDIV"))
- IF $PIECE(INMSG0,U,21)'=INSRCH("INDIV")
- QUIT
- +31 IF $DATA(INSRCH("MULTIDIV"))
- SET INQ=0
- Begin DoDot:1
- +32 SET X=0
- FOR
- SET X=$ORDER(INSRCH("MULTIDIV",X))
- IF 'X
- QUIT
- IF ($PIECE(INMSG0,U,21)=X)
- SET INQ=1
- QUIT
- End DoDot:1
- IF 'INQ
- QUIT
- +33 ; Test value of the Error Location, Error Resolution Status and Error Text to search
- +34 IF $DATA(INSRCH("INERLOC"))
- IF $PIECE(INERR0,U,5)'=INSRCH("INERLOC")
- QUIT
- +35 IF $DATA(INSRCH("INERSTAT"))
- IF $PIECE(INERR0,U,10)'=INSRCH("INERSTAT")
- QUIT
- +36 IF $DATA(INSRCH("INTEXT"))>9
- IF '$$INERSRCH^INHERR1(.INSRCH,INEIEN,INSRCH("INTYPE"))
- QUIT
- +37 ; Checking the Interface Message file
- +38 ; Test value of the Message Start Date and Message End Date
- +39 IF $DATA(INSRCH("INMSGSTART"))
- IF ($PIECE(INMSG0,U)<INSRCH("INMSGSTART"))
- QUIT
- +40 IF $DATA(INSRCH("INMSGEND"))
- IF ($PIECE(INMSG0,U)>INSRCH("INMSGEND"))
- QUIT
- +41 ; Test value of the Message ID, Direction, User, Source and Patient
- +42 IF $DATA(INSRCH("INID"))
- IF $PIECE(INMSG0,U,5)'=INSRCH("INID")
- QUIT
- +43 IF $DATA(INSRCH("INDIR"))
- IF $PIECE(INMSG0,U,10)'=INSRCH("INDIR")
- QUIT
- +44 IF $DATA(INSRCH("INSOURCE"))
- IF $EXTRACT($PIECE(INMSG0,U,8),1,$LENGTH(INSRCH("INSOURCE")))'=INSRCH("INSOURCE")
- QUIT
- +45 IF $DATA(INSRCH("INUSER"))
- IF ($PIECE(INMSG0,U,15)'=INSRCH("INUSER"))&($PIECE(INERR0,U,8)'=INSRCH("INUSER"))
- QUIT
- +46 IF $DATA(INSRCH("INPAT"))
- IF 'INMIEN
- QUIT
- IF '$$INMSPAT^INHMS1(INMIEN,INSRCH("INPAT"))
- QUIT
- +47 SET INFND=1
- +48 QUIT
- +49 ;
- MSGSTD(INIEN) ; return the message standard for a given entry in the UIF
- +1 ;
- +2 ; INIEN = IEN into ^INTHU
- +3 ;
- +4 NEW INMSG0,INORIGTT,INREP,INSCR
- +5 SET INIEN=$GET(INIEN)
- IF 'INIEN
- QUIT ""
- +6 SET INMSG0=$GET(^INTHU(INIEN,0))
- IF '$LENGTH(INMSG0)
- QUIT ""
- +7 ; if incoming message, the parent message field points to the
- +8 ; outgoing message
- +9 IF $PIECE(INMSG0,U,10)="I"
- Begin DoDot:1
- +10 SET INIEN=$PIECE(INMSG0,U,7)
- IF 'INIEN
- QUIT
- +11 SET INMSG0=$GET(^INTHU(INIEN,0))
- End DoDot:1
- IF '$LENGTH(INMSG0)!('INIEN)
- QUIT ""
- +12 SET INORIGTT=$PIECE(INMSG0,U,11)
- IF 'INORIGTT
- QUIT ""
- +13 SET INSCR=$PIECE($GET(^INRHT(INORIGTT,0)),U,3)
- IF 'INSCR
- Begin DoDot:1
- +14 ; Special processing for replicated messages, if no script pointer
- +15 SET INREP=$ORDER(^INRHR("B",INORIGTT,""))
- IF 'INREP
- QUIT
- +16 SET INORIGTT=$PIECE($GET(^INRHR(INREP,0)),U,2)
- IF 'INORIGTT
- QUIT
- +17 SET INSCR=$PIECE($GET(^INRHT(INORIGTT,0)),U,3)
- End DoDot:1
- IF 'INSCR
- QUIT ""
- +18 QUIT $PIECE($GET(^INRHS(INSCR,0)),U,7)
- +19 ;
- INNCPAT(INIEN,INPAT,INPATNA) ; Test msg. for a NCPDP patient match
- +1 ;
- +2 ; MODULE NAME: INNCPAT (Interface Message PATIENT Search for NCPDP msg)
- +3 ; DESCRIPTION: Search ^INTHU( INIEN ) Pharm. claim message for matching
- +4 ; values to the string: INPAT. Using CHCS patient IEN for
- +5 ; outbound messages, and Pharmacy Prescription Number.
- +6 ; RETURN = PASS/FAIL (1/0) and patient found set in INPATNAM
- +7 ; PARAMETERS:
- +8 ; INIEN = The IEN of the message in the ^INTHU message file
- +9 ; INPAT = The patients internal IEN from the ^DPT file
- +10 ; INPATNA = The patient name found in the message ("" if none)
- +11 ;
- +12 SET INIEN=$GET(INIEN)
- SET INPAT=+$GET(INPAT)
- SET INPATNAM=$GET(INPATNA)
- +13 IF 'INIEN
- QUIT 0
- +14 NEW INBLDCT,INBLDTXT,INRET,INRXNUM
- +15 ; Pharmacy claim message is in line 3
- +16 SET INBLDTXT=""
- SET INBLDCT=2
- DO GETLINE^INHOU(INIEN,.INBLDCT,.INBLDTXT)
- +17 IF '$DATA(INBLDTXT)
- QUIT 0
- +18 ; prescription number is the first field and is 7 bytes
- +19 SET INRXNUM=+$EXTRACT(INBLDTXT,1,7)
- SET INRET=$$NCMATCH(INPAT,INRXNUM)
- SET INPATNAM=$PIECE(INRET,U,2)
- +20 QUIT INRET
- +21 ;
- NCMATCH(INPAT,INRXNUM) ; For a given RX number find a patient match
- +1 ;
- +2 ; Input: INPAT (req) = IEN for the Patient
- +3 ; INRXNUM (req) = Prescription number from the NCPDP message
- +4 ; Output: 1_"^"_Patient IEN, if match found
- +5 ; 0, otherwise
- +6 ;
- +7 NEW INC0,INCPT,INCOLLEC,INDPT
- +8 SET INPAT=$GET(INPAT)
- IF 'INPAT
- QUIT 0
- +9 SET INCOLLEC=$ORDER(^PSM(8216,"B",INRXNUM,0))
- IF 'INCOLLEC
- QUIT 0
- +10 SET INC0=$GET(^PSM(8216,INCOLLEC,0))
- IF '$LENGTH(INC0)
- QUIT 0
- +11 SET INCPT=$PIECE(INC0,U,5)
- IF INCPT
- SET INDPT=$PIECE($GET(^DPT(INCPT,0)),U)
- +12 IF INPAT=INCPT
- QUIT 1_"^"_INDPT
- +13 QUIT 0
