HLUOPTF1 ;ALB/CJM-HL7 -Set Logic for the AI x-ref on file 773 ;02/04/2004
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
;
PXREF(IEN,STATUS) ;sets the AI x-ref on file 773 and the FAST PURGE DT/TM fields in file 772 and 773
;Input: IEN is the ien of record in file 773
; STATUS is the new value of the STATUS field
;Output: none
;
Q:'$G(IEN)
;
;don't set the x-ref if status is not Successfully Completed
Q:($G(STATUS)'=3)
;
N NODE,WHEN,CHILD
;
;also not if DON'T PURGE field is set
Q:$P($G(^HLMA(IEN,2)),"^")=1
;
;also not if this isn't the initial message
S NODE=$G(^HLMA(IEN,0))
I $P(NODE,"^",6),$P(NODE,"^",6)'=IEN Q
;
;This record can be purged via FAST PURGE
;determine the dt/tm the record can be purged
S WHEN=$$NOW^XLFDT
S WHEN=$$FMADD^XLFDT(WHEN,$$WAIT)
;
;set the FAST PURGE DT/TM and x-ref, and do the same for file 772 record
D SET(IEN,WHEN,+NODE)
;
;All the records in file 773 that point to this record (children) should be purged at the same time
S CHILD=0
F S CHILD=$O(^HLMA("AF",IEN,CHILD)) Q:'CHILD D:(CHILD'=IEN) SET(CHILD,WHEN,+$G(^HLMA(CHILD,0)))
Q
;
SET(IEN773,WHEN,IEN772) ;sets FAST PURGE DT/TM for and the AI x~ref for both file 772 & 773
;Input:
; IEN773 - ien of record to be purged in file 773
; WHEN - date/time to purge
; IEN772 - ien of corresponding record in file 772
;
N OLDWHEN
;if the fast purge dt/tm changed, kill the old xref
S OLDWHEN=$P($G(^HLMA(IEN773,2)),"^",2)
I $L(OLDWHEN) K ^HLMA("AI",OLDWHEN,773,IEN773)
;
;set the FAST PURGE DATE
S $P(^HLMA(IEN773,2),"^",2)=WHEN
;
;set the AI x-ref
S ^HLMA("AI",WHEN,773,IEN773)=""
;
;do the same for the corresponding entry in file 772
I IEN772,$D(^HL(772,IEN772,0)) D
.;if the fast purge dt/tm changed, kill the old xref
.S OLDWHEN=$P($G(^HL(772,IEN772,2)),"^",2)
.I $L(OLDWHEN) K ^HLMA("AI",OLDWHEN,772,IEN772)
.;set the FAST PURGE DATE
.S $P(^HL(772,IEN772,2),"^",2)=WHEN
.;
.;set the AI x-ref
.S ^HLMA("AI",WHEN,772,IEN772)=""
Q
;
WAIT() ;
;returns the wait time to purge completed messages from file 869.3
N IEN
S IEN=$O(^HLCS(869.3,0))
Q:'IEN 0
Q +$G(^HLCS(869.3,IEN,4))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLUOPTF1 2215 printed Oct 16, 2024@18:01:12 Page 2
HLUOPTF1 ;ALB/CJM-HL7 -Set Logic for the AI x-ref on file 773 ;02/04/2004
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
+2 ;
PXREF(IEN,STATUS) ;sets the AI x-ref on file 773 and the FAST PURGE DT/TM fields in file 772 and 773
+1 ;Input: IEN is the ien of record in file 773
+2 ; STATUS is the new value of the STATUS field
+3 ;Output: none
+4 ;
+5 if '$GET(IEN)
QUIT
+6 ;
+7 ;don't set the x-ref if status is not Successfully Completed
+8 if ($GET(STATUS)'=3)
QUIT
+9 ;
+10 NEW NODE,WHEN,CHILD
+11 ;
+12 ;also not if DON'T PURGE field is set
+13 if $PIECE($GET(^HLMA(IEN,2)),"^")=1
QUIT
+14 ;
+15 ;also not if this isn't the initial message
+16 SET NODE=$GET(^HLMA(IEN,0))
+17 IF $PIECE(NODE,"^",6)
IF $PIECE(NODE,"^",6)'=IEN
QUIT
+18 ;
+19 ;This record can be purged via FAST PURGE
+20 ;determine the dt/tm the record can be purged
+21 SET WHEN=$$NOW^XLFDT
+22 SET WHEN=$$FMADD^XLFDT(WHEN,$$WAIT)
+23 ;
+24 ;set the FAST PURGE DT/TM and x-ref, and do the same for file 772 record
+25 DO SET(IEN,WHEN,+NODE)
+26 ;
+27 ;All the records in file 773 that point to this record (children) should be purged at the same time
+28 SET CHILD=0
+29 FOR
SET CHILD=$ORDER(^HLMA("AF",IEN,CHILD))
if 'CHILD
QUIT
if (CHILD'=IEN)
DO SET(CHILD,WHEN,+$GET(^HLMA(CHILD,0)))
+30 QUIT
+31 ;
SET(IEN773,WHEN,IEN772) ;sets FAST PURGE DT/TM for and the AI x~ref for both file 772 & 773
+1 ;Input:
+2 ; IEN773 - ien of record to be purged in file 773
+3 ; WHEN - date/time to purge
+4 ; IEN772 - ien of corresponding record in file 772
+5 ;
+6 NEW OLDWHEN
+7 ;if the fast purge dt/tm changed, kill the old xref
+8 SET OLDWHEN=$PIECE($GET(^HLMA(IEN773,2)),"^",2)
+9 IF $LENGTH(OLDWHEN)
KILL ^HLMA("AI",OLDWHEN,773,IEN773)
+10 ;
+11 ;set the FAST PURGE DATE
+12 SET $PIECE(^HLMA(IEN773,2),"^",2)=WHEN
+13 ;
+14 ;set the AI x-ref
+15 SET ^HLMA("AI",WHEN,773,IEN773)=""
+16 ;
+17 ;do the same for the corresponding entry in file 772
+18 IF IEN772
IF $DATA(^HL(772,IEN772,0))
Begin DoDot:1
+19 ;if the fast purge dt/tm changed, kill the old xref
+20 SET OLDWHEN=$PIECE($GET(^HL(772,IEN772,2)),"^",2)
+21 IF $LENGTH(OLDWHEN)
KILL ^HLMA("AI",OLDWHEN,772,IEN772)
+22 ;set the FAST PURGE DATE
+23 SET $PIECE(^HL(772,IEN772,2),"^",2)=WHEN
+24 ;
+25 ;set the AI x-ref
+26 SET ^HLMA("AI",WHEN,772,IEN772)=""
End DoDot:1
+27 QUIT
+28 ;
WAIT() ;
+1 ;returns the wait time to purge completed messages from file 869.3
+2 NEW IEN
+3 SET IEN=$ORDER(^HLCS(869.3,0))
+4 if 'IEN
QUIT 0
+5 QUIT +$GET(^HLCS(869.3,IEN,4))
