SCMCHLX1 ;BP/DJB - PCMM HL7 EVENT File Xref Code ; 13 Dec 2002 1:25 PM
;;5.3;Scheduling;**177,264,272,515**;May 01, 1999;Build 14
;
TXREF(IFN) ;Logic for AEVENT* xrefs on TEAM file (404.51). Create entry in
; PCMM HL7 EVENT file.
;
; Input: IFN - Pointer to entry in file
;Output: None
;
;Check input
Q:'$G(IFN)
;
;Declare variables
NEW DFN,DFNPTR,ND,VARPTR
;
;Store event variable pointer
S VARPTR=IFN_";SCTM(404.51,"
;
;Quit if an event entry already exists for this record
Q:$D(^SCPT(404.48,"AACXMIT",VARPTR))
;
;Create an entry in PCMM HL7 EVENT file (#404.48)
D ADD^SCMCHLE("NOW",VARPTR)
Q
;
PTXREF(IFN,OLDTYPE) ;Logic for AEVENT* xrefs on PATIENT TEAM ASSIGN file
; (404.42). Create entry in PCMM HL7 EVENT file.
;
; Input: IFN - Pointer to entry in file
; OLDTYPE - If OLDTYPE=1 then send a deletion since it's no
; longer a primary care team.
;Output: None
;
;Check input
Q:'$G(IFN)
;
;Declare variables
NEW DFN,ND,VARPTR
;
;Get data
S ND=$G(^SCPT(404.42,IFN,0)) ;.........Zero node of 404.42
Q:ND']""
I $P(ND,U,8)'=1,$G(OLDTYPE)'=1 Q ;....Not Primary Care related
S DFN=$P(ND,U,1) ;.....................Get pointer to 404.42
Q:'DFN
;
;Store event variable pointer.
S VARPTR=IFN_";SCPT(404.42,"
;
;Quit if an event entry for this record is already set to transmit.
Q:$D(^SCPT(404.48,"AACXMIT",VARPTR))
;
;If event entry exists, turn on transmission flag.
;I $D(^SCPT(404.48,"AC",VARPTR)) D TRANSMIT^SCMCHLE(VARPTR,1) Q
;
;Create an entry in PCMM HL7 EVENT file (#404.48).
D ADD^SCMCHLE("NOW",VARPTR,DFN)
Q
;
PTPXREF(IFN,OLDROLE) ;Logic for AEVENT* xrefs on PATIENT TEAM POSITION ASSIGN
; file (404.43). Create entry in PCMM HL7 EVENT file.
;
; Input: IFN - Pointer to entry in file
; OLDROLE - If OLDROLE=1 then send a deletion since it's no
; longer a primary care position.
;Output: None
;
;Check input
Q:'$G(IFN)
;
;Declare variables
NEW DFN,DFNPTR,ND,TP,VARPTR
;
;Get data
S ND=$G(^SCPT(404.43,IFN,0)) ;............Zero node of 404.43
Q:ND']""
;I $P(ND,U,5)'=1,$G(OLDROLE)'=1 Q ;.......Not Primary Care related
S SCTPA=$$TPACHK^SCMCHLB("",IFN) ; 20070518 PATCH 515
I ($P(ND,U,5)'=1)&($G(OLDROLE)'=1)&(SCTPA=0) Q ;.......Not Primary Care AND NOT TPA
S DFNPTR=$P(ND,U,1) ;.....................Get pointer to 404.42
Q:'DFNPTR
S DFN=$P($G(^SCPT(404.42,DFNPTR,0)),U,1) ;Pointer to PATIENT file
Q:'DFN
S TP=$P(ND,U,2) ;.........................Team Position
;
;Store event variable pointer
S VARPTR=IFN_";SCPT(404.43,"
;
;Quit if an event entry already exists for this record
Q:$D(^SCPT(404.48,"AACXMIT",VARPTR))
;
;Create an entry in PCMM HL7 EVENT file (#404.48)
D ADD^SCMCHLE("NOW",VARPTR,DFN,TP)
Q
;
POSHXREF(IFN) ;Logic for AEVENT* xrefs on POSITION ASSIGNMENT HISTORY file
; (404.52). Create entry in PCMM HL7 EVENT file.
;
; Input: IFN - Pointer to entry in file
;Output: None
;
;Check input
Q:'$G(IFN)
;
;Declare variables
NEW ND,TP,VARPTR
;
;Get data
S ND=$G(^SCTM(404.52,IFN,0)) ;..Zero node of 404.52
S TP=$P(ND,U,1) ;...............Team Position
;
;Store event variable pointer
S VARPTR=IFN_";SCTM(404.52,"
;
;Quit if an event entry already exists for this record
Q:$D(^SCPT(404.48,"AACXMIT",VARPTR))
;
;Create an entry in PCMM HL7 EVENT file (#404.48)
D ADD^SCMCHLE("NOW",VARPTR,,TP)
Q
;
PREHXREF(IFN) ;Logic for AEVENT* xrefs on PRECEPTOR ASSIGNMENT HISTORY file
; (404.53). Create entry in PCMM HL7 EVENT file.
;
; Input: IFN - Pointer to entry in file
;Output: None
;
;Check input
Q:'$G(IFN)
;
;Declare variables
NEW ND,TP,VARPTR
;
;Store event variable pointer
S VARPTR=IFN_";SCTM(404.53,"
;
;Get data
S ND=$G(^SCTM(404.53,IFN,0)) ;....Zero node of 404.53
S TP=$P(ND,U,1)_"-"_$P(ND,U,6) ;..Team Position: Preceptee-Preceptor
;
;Quit if an event entry already exists for this record
Q:$D(^SCPT(404.48,"AACXMIT",VARPTR))
;
;Create an entry in PCMM HL7 EVENT file (#404.48)
D ADD^SCMCHLE("NOW",VARPTR,,TP)
Q
POSBXREF(IFN,FILE) ;
; (404.52). Create entry in PCMM HL7 EVENT file.
;
; Input: IFN - Pointer to entry in file
;Output: None
S:'$G(FILE) FILE=404.52
I FILE=404.52 Q:'$P($G(^SCTM(404.57,+$G(^SCTM(404.52,+$G(IFN),0)),0)),U,4) ;quit if not pc
;
; ;Check input
Q:'$G(IFN)
;
;Declare variables
NEW ND,TP,VARPTR
;
;Get data
S ND=$G(^SCTM(404.52,IFN,0)) ;..Zero node of 404.52
S TP=$P(ND,U,1) I FILE=404.57 S TP=IFN ;...............Team Position
;
;Store event variable pointer
S VARPTR=IFN_";SCTM("_FILE_","
;
;Quit if an event entry already exists for this record
N QUIT,I S QUIT=0
F I=0:0 S I=$O(^SCPT(404.48,"AACXMIT",VARPTR,I)) Q:'I I $P($G(^SCPT(404.48,I,0)),U,8) S QUIT=1 Q
Q:QUIT
;
;Create an entry in PCMM HL7 EVENT file (#404.48)
D ADD^SCMCHLE("NOW",VARPTR,,TP,1)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCHLX1 5027 printed Sep 23, 2025@20:17:05 Page 2
SCMCHLX1 ;BP/DJB - PCMM HL7 EVENT File Xref Code ; 13 Dec 2002 1:25 PM
+1 ;;5.3;Scheduling;**177,264,272,515**;May 01, 1999;Build 14
+2 ;
TXREF(IFN) ;Logic for AEVENT* xrefs on TEAM file (404.51). Create entry in
+1 ; PCMM HL7 EVENT file.
+2 ;
+3 ; Input: IFN - Pointer to entry in file
+4 ;Output: None
+5 ;
+6 ;Check input
+7 if '$GET(IFN)
QUIT
+8 ;
+9 ;Declare variables
+10 NEW DFN,DFNPTR,ND,VARPTR
+11 ;
+12 ;Store event variable pointer
+13 SET VARPTR=IFN_";SCTM(404.51,"
+14 ;
+15 ;Quit if an event entry already exists for this record
+16 if $DATA(^SCPT(404.48,"AACXMIT",VARPTR))
QUIT
+17 ;
+18 ;Create an entry in PCMM HL7 EVENT file (#404.48)
+19 DO ADD^SCMCHLE("NOW",VARPTR)
+20 QUIT
+21 ;
PTXREF(IFN,OLDTYPE) ;Logic for AEVENT* xrefs on PATIENT TEAM ASSIGN file
+1 ; (404.42). Create entry in PCMM HL7 EVENT file.
+2 ;
+3 ; Input: IFN - Pointer to entry in file
+4 ; OLDTYPE - If OLDTYPE=1 then send a deletion since it's no
+5 ; longer a primary care team.
+6 ;Output: None
+7 ;
+8 ;Check input
+9 if '$GET(IFN)
QUIT
+10 ;
+11 ;Declare variables
+12 NEW DFN,ND,VARPTR
+13 ;
+14 ;Get data
+15 ;.........Zero node of 404.42
SET ND=$GET(^SCPT(404.42,IFN,0))
+16 if ND']""
QUIT
+17 ;....Not Primary Care related
IF $PIECE(ND,U,8)'=1
IF $GET(OLDTYPE)'=1
QUIT
+18 ;.....................Get pointer to 404.42
SET DFN=$PIECE(ND,U,1)
+19 if 'DFN
QUIT
+20 ;
+21 ;Store event variable pointer.
+22 SET VARPTR=IFN_";SCPT(404.42,"
+23 ;
+24 ;Quit if an event entry for this record is already set to transmit.
+25 if $DATA(^SCPT(404.48,"AACXMIT",VARPTR))
QUIT
+26 ;
+27 ;If event entry exists, turn on transmission flag.
+28 ;I $D(^SCPT(404.48,"AC",VARPTR)) D TRANSMIT^SCMCHLE(VARPTR,1) Q
+29 ;
+30 ;Create an entry in PCMM HL7 EVENT file (#404.48).
+31 DO ADD^SCMCHLE("NOW",VARPTR,DFN)
+32 QUIT
+33 ;
PTPXREF(IFN,OLDROLE) ;Logic for AEVENT* xrefs on PATIENT TEAM POSITION ASSIGN
+1 ; file (404.43). Create entry in PCMM HL7 EVENT file.
+2 ;
+3 ; Input: IFN - Pointer to entry in file
+4 ; OLDROLE - If OLDROLE=1 then send a deletion since it's no
+5 ; longer a primary care position.
+6 ;Output: None
+7 ;
+8 ;Check input
+9 if '$GET(IFN)
QUIT
+10 ;
+11 ;Declare variables
+12 NEW DFN,DFNPTR,ND,TP,VARPTR
+13 ;
+14 ;Get data
+15 ;............Zero node of 404.43
SET ND=$GET(^SCPT(404.43,IFN,0))
+16 if ND']""
QUIT
+17 ;I $P(ND,U,5)'=1,$G(OLDROLE)'=1 Q ;.......Not Primary Care related
+18 ; 20070518 PATCH 515
SET SCTPA=$$TPACHK^SCMCHLB("",IFN)
+19 ;.......Not Primary Care AND NOT TPA
IF ($PIECE(ND,U,5)'=1)&($GET(OLDROLE)'=1)&(SCTPA=0)
QUIT
+20 ;.....................Get pointer to 404.42
SET DFNPTR=$PIECE(ND,U,1)
+21 if 'DFNPTR
QUIT
+22 ;Pointer to PATIENT file
SET DFN=$PIECE($GET(^SCPT(404.42,DFNPTR,0)),U,1)
+23 if 'DFN
QUIT
+24 ;.........................Team Position
SET TP=$PIECE(ND,U,2)
+25 ;
+26 ;Store event variable pointer
+27 SET VARPTR=IFN_";SCPT(404.43,"
+28 ;
+29 ;Quit if an event entry already exists for this record
+30 if $DATA(^SCPT(404.48,"AACXMIT",VARPTR))
QUIT
+31 ;
+32 ;Create an entry in PCMM HL7 EVENT file (#404.48)
+33 DO ADD^SCMCHLE("NOW",VARPTR,DFN,TP)
+34 QUIT
+35 ;
POSHXREF(IFN) ;Logic for AEVENT* xrefs on POSITION ASSIGNMENT HISTORY file
+1 ; (404.52). Create entry in PCMM HL7 EVENT file.
+2 ;
+3 ; Input: IFN - Pointer to entry in file
+4 ;Output: None
+5 ;
+6 ;Check input
+7 if '$GET(IFN)
QUIT
+8 ;
+9 ;Declare variables
+10 NEW ND,TP,VARPTR
+11 ;
+12 ;Get data
+13 ;..Zero node of 404.52
SET ND=$GET(^SCTM(404.52,IFN,0))
+14 ;...............Team Position
SET TP=$PIECE(ND,U,1)
+15 ;
+16 ;Store event variable pointer
+17 SET VARPTR=IFN_";SCTM(404.52,"
+18 ;
+19 ;Quit if an event entry already exists for this record
+20 if $DATA(^SCPT(404.48,"AACXMIT",VARPTR))
QUIT
+21 ;
+22 ;Create an entry in PCMM HL7 EVENT file (#404.48)
+23 DO ADD^SCMCHLE("NOW",VARPTR,,TP)
+24 QUIT
+25 ;
PREHXREF(IFN) ;Logic for AEVENT* xrefs on PRECEPTOR ASSIGNMENT HISTORY file
+1 ; (404.53). Create entry in PCMM HL7 EVENT file.
+2 ;
+3 ; Input: IFN - Pointer to entry in file
+4 ;Output: None
+5 ;
+6 ;Check input
+7 if '$GET(IFN)
QUIT
+8 ;
+9 ;Declare variables
+10 NEW ND,TP,VARPTR
+11 ;
+12 ;Store event variable pointer
+13 SET VARPTR=IFN_";SCTM(404.53,"
+14 ;
+15 ;Get data
+16 ;....Zero node of 404.53
SET ND=$GET(^SCTM(404.53,IFN,0))
+17 ;..Team Position: Preceptee-Preceptor
SET TP=$PIECE(ND,U,1)_"-"_$PIECE(ND,U,6)
+18 ;
+19 ;Quit if an event entry already exists for this record
+20 if $DATA(^SCPT(404.48,"AACXMIT",VARPTR))
QUIT
+21 ;
+22 ;Create an entry in PCMM HL7 EVENT file (#404.48)
+23 DO ADD^SCMCHLE("NOW",VARPTR,,TP)
+24 QUIT
POSBXREF(IFN,FILE) ;
+1 ; (404.52). Create entry in PCMM HL7 EVENT file.
+2 ;
+3 ; Input: IFN - Pointer to entry in file
+4 ;Output: None
+5 if '$GET(FILE)
SET FILE=404.52
+6 ;quit if not pc
IF FILE=404.52
if '$PIECE($GET(^SCTM(404.57,+$GET(^SCTM(404.52,+$GET(IFN),0)),0)),U,4)
QUIT
+7 ;
+8 ; ;Check input
+9 if '$GET(IFN)
QUIT
+10 ;
+11 ;Declare variables
+12 NEW ND,TP,VARPTR
+13 ;
+14 ;Get data
+15 ;..Zero node of 404.52
SET ND=$GET(^SCTM(404.52,IFN,0))
+16 ;...............Team Position
SET TP=$PIECE(ND,U,1)
IF FILE=404.57
SET TP=IFN
+17 ;
+18 ;Store event variable pointer
+19 SET VARPTR=IFN_";SCTM("_FILE_","
+20 ;
+21 ;Quit if an event entry already exists for this record
+22 NEW QUIT,I
SET QUIT=0
+23 FOR I=0:0
SET I=$ORDER(^SCPT(404.48,"AACXMIT",VARPTR,I))
if 'I
QUIT
IF $PIECE($GET(^SCPT(404.48,I,0)),U,8)
SET QUIT=1
QUIT
+24 if QUIT
QUIT
+25 ;
+26 ;Create an entry in PCMM HL7 EVENT file (#404.48)
+27 DO ADD^SCMCHLE("NOW",VARPTR,,TP,1)
+28 QUIT
+29 ;
