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
