- BTIUXREF ; IHS/ITSC/LJF - IHS XREFERENCE CODE ;
- ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
- ;
- AIHS1A ;EP; add code for AIHS xref on Patient field
- NEW TIU S TIU=$G(^TIU(8925,+DA,0)) Q:TIU=""
- I $P(TIU,U),$P(TIU,U,3),$P(TIU,U,5) D
- . S ^TIU(8925,"AIHS1",+X,+$P(TIU,U),+$P(TIU,U,5),(9999999-$P($G(^AUPNVSIT(+$P(TIU,U,3),0)),".")),+DA)=""
- Q
- ;
- AIHS1K ;EP; kill code for AIHS xref on Patient field
- NEW TIU S TIU=$G(^TIU(8925,+DA,0)) Q:TIU=""
- I $P(TIU,U),$P(TIU,U,3),$P(TIU,U,5) D
- . K ^TIU(8925,"AIHS1",+X,+$P(TIU,U),+$P(TIU,U,5),(9999999-$P($G(^AUPNVSIT(+$P(TIU,U,3),0)),".")),+DA)
- Q
- ;
- AIHS11A ;EP; add code for AIHS xref on Visit field
- NEW TIU S TIU=$G(^TIU(8925,+DA,0)) Q:TIU=""
- I $P(TIU,U),$P(TIU,U,2),$P(TIU,U,5) D
- . S ^TIU(8925,"AIHS1",+$P(TIU,U,2),+$P(TIU,U),+$P(TIU,U,5),(9999999-$P($G(^AUPNVSIT(X,0)),".")),+DA)=""
- Q
- ;
- AIHS11K ;EP; kill code for AIHS xref on Visit field
- NEW TIU S TIU=$G(^TIU(8925,+DA,0)) Q:TIU=""
- I $P(TIU,U),$P(TIU,U,2),$P(TIU,U,5) D
- . K ^TIU(8925,"AIHS1",+$P(TIU,U,2),+$P(TIU,U),+$P(TIU,U,5),(9999999-$P($G(^AUPNVSIT(X,0)),".")),+DA)
- Q
- ;
- AIHS12A ;EP; add code for AIHS xref on Doc Type field
- NEW TIU S TIU=$G(^TIU(8925,+DA,0)) Q:TIU=""
- I $P(TIU,U,2),$P(TIU,U,3),$P(TIU,U,5) D
- . S ^TIU(8925,"AIHS1",+$P(TIU,U,2),+X,+$P(TIU,U,5),(9999999-$P($G(^AUPNVSIT(+$P(TIU,U,3),0)),".")),+DA)=""
- Q
- ;
- AIHS12K ;EP; kill code for AIHS xref on Doc Type field
- NEW TIU S TIU=$G(^TIU(8925,+DA,0)) Q:TIU=""
- I $P(TIU,U,2),$P(TIU,U,3),$P(TIU,U,5) D
- . K ^TIU(8925,"AIHS1",+$P(TIU,U,2),+X,+$P(TIU,U,5),(9999999-$P($G(^AUPNVSIT(+$P(TIU,U,3),0)),".")),+DA)
- Q
- ;
- AIHS13A ;EP; add code for AIHS xref on Status field
- NEW TIU S TIU=$G(^TIU(8925,+DA,0)) Q:TIU=""
- I $P(TIU,U),$P(TIU,U,2),$P(TIU,U,3) D
- . S ^TIU(8925,"AIHS1",+$P(TIU,U,2),+$P(TIU,U),+X,(9999999-$P($G(^AUPNVSIT(+$P(TIU,U,3),0)),".")),+DA)=""
- Q
- ;
- AIHS13K ;EP; kill code for AIHS xref on Status field
- NEW TIU S TIU=$G(^TIU(8925,+DA,0)) Q:TIU=""
- I $P(TIU,U),$P(TIU,U,2),$P(TIU,U,3) D
- . K ^TIU(8925,"AIHS1",+$P(TIU,U,2),+$P(TIU,U),+X,(9999999-$P($G(^AUPNVSIT(+$P(TIU,U,3),0)),".")),+DA)
- Q
- BTIUXREF ; IHS/ITSC/LJF - IHS XREFERENCE CODE ;
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
- +2 ;
- AIHS1A ;EP; add code for AIHS xref on Patient field
- +1 NEW TIU
- SET TIU=$GET(^TIU(8925,+DA,0))
- IF TIU=""
- QUIT
- +2 IF $PIECE(TIU,U)
- IF $PIECE(TIU,U,3)
- IF $PIECE(TIU,U,5)
- Begin DoDot:1
- +3 SET ^TIU(8925,"AIHS1",+X,+$PIECE(TIU,U),+$PIECE(TIU,U,5),(9999999-$PIECE($GET(^AUPNVSIT(+$PIECE(TIU,U,3),0)),".")),+DA)=""
- End DoDot:1
- +4 QUIT
- +5 ;
- AIHS1K ;EP; kill code for AIHS xref on Patient field
- +1 NEW TIU
- SET TIU=$GET(^TIU(8925,+DA,0))
- IF TIU=""
- QUIT
- +2 IF $PIECE(TIU,U)
- IF $PIECE(TIU,U,3)
- IF $PIECE(TIU,U,5)
- Begin DoDot:1
- +3 KILL ^TIU(8925,"AIHS1",+X,+$PIECE(TIU,U),+$PIECE(TIU,U,5),(9999999-$PIECE($GET(^AUPNVSIT(+$PIECE(TIU,U,3),0)),".")),+DA)
- End DoDot:1
- +4 QUIT
- +5 ;
- AIHS11A ;EP; add code for AIHS xref on Visit field
- +1 NEW TIU
- SET TIU=$GET(^TIU(8925,+DA,0))
- IF TIU=""
- QUIT
- +2 IF $PIECE(TIU,U)
- IF $PIECE(TIU,U,2)
- IF $PIECE(TIU,U,5)
- Begin DoDot:1
- +3 SET ^TIU(8925,"AIHS1",+$PIECE(TIU,U,2),+$PIECE(TIU,U),+$PIECE(TIU,U,5),(9999999-$PIECE($GET(^AUPNVSIT(X,0)),".")),+DA)=""
- End DoDot:1
- +4 QUIT
- +5 ;
- AIHS11K ;EP; kill code for AIHS xref on Visit field
- +1 NEW TIU
- SET TIU=$GET(^TIU(8925,+DA,0))
- IF TIU=""
- QUIT
- +2 IF $PIECE(TIU,U)
- IF $PIECE(TIU,U,2)
- IF $PIECE(TIU,U,5)
- Begin DoDot:1
- +3 KILL ^TIU(8925,"AIHS1",+$PIECE(TIU,U,2),+$PIECE(TIU,U),+$PIECE(TIU,U,5),(9999999-$PIECE($GET(^AUPNVSIT(X,0)),".")),+DA)
- End DoDot:1
- +4 QUIT
- +5 ;
- AIHS12A ;EP; add code for AIHS xref on Doc Type field
- +1 NEW TIU
- SET TIU=$GET(^TIU(8925,+DA,0))
- IF TIU=""
- QUIT
- +2 IF $PIECE(TIU,U,2)
- IF $PIECE(TIU,U,3)
- IF $PIECE(TIU,U,5)
- Begin DoDot:1
- +3 SET ^TIU(8925,"AIHS1",+$PIECE(TIU,U,2),+X,+$PIECE(TIU,U,5),(9999999-$PIECE($GET(^AUPNVSIT(+$PIECE(TIU,U,3),0)),".")),+DA)=""
- End DoDot:1
- +4 QUIT
- +5 ;
- AIHS12K ;EP; kill code for AIHS xref on Doc Type field
- +1 NEW TIU
- SET TIU=$GET(^TIU(8925,+DA,0))
- IF TIU=""
- QUIT
- +2 IF $PIECE(TIU,U,2)
- IF $PIECE(TIU,U,3)
- IF $PIECE(TIU,U,5)
- Begin DoDot:1
- +3 KILL ^TIU(8925,"AIHS1",+$PIECE(TIU,U,2),+X,+$PIECE(TIU,U,5),(9999999-$PIECE($GET(^AUPNVSIT(+$PIECE(TIU,U,3),0)),".")),+DA)
- End DoDot:1
- +4 QUIT
- +5 ;
- AIHS13A ;EP; add code for AIHS xref on Status field
- +1 NEW TIU
- SET TIU=$GET(^TIU(8925,+DA,0))
- IF TIU=""
- QUIT
- +2 IF $PIECE(TIU,U)
- IF $PIECE(TIU,U,2)
- IF $PIECE(TIU,U,3)
- Begin DoDot:1
- +3 SET ^TIU(8925,"AIHS1",+$PIECE(TIU,U,2),+$PIECE(TIU,U),+X,(9999999-$PIECE($GET(^AUPNVSIT(+$PIECE(TIU,U,3),0)),".")),+DA)=""
- End DoDot:1
- +4 QUIT
- +5 ;
- AIHS13K ;EP; kill code for AIHS xref on Status field
- +1 NEW TIU
- SET TIU=$GET(^TIU(8925,+DA,0))
- IF TIU=""
- QUIT
- +2 IF $PIECE(TIU,U)
- IF $PIECE(TIU,U,2)
- IF $PIECE(TIU,U,3)
- Begin DoDot:1
- +3 KILL ^TIU(8925,"AIHS1",+$PIECE(TIU,U,2),+$PIECE(TIU,U),+X,(9999999-$PIECE($GET(^AUPNVSIT(+$PIECE(TIU,U,3),0)),".")),+DA)
- End DoDot:1
- +4 QUIT
